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
113
114
115
116
117
118
119
120
121
122
123
124
125
|
package Test::Unit::Assertion::CodeRef;
use strict;
use base qw/Test::Unit::Assertion/;
use Carp;
use Test::Unit::Debug qw(debug);
my $deparser;
sub new {
my $class = shift;
my $code = shift;
croak "$class\::new needs a CODEREF" unless ref($code) eq 'CODE';
bless \$code => $class;
}
sub do_assertion {
my $self = shift;
my $possible_object = $_[0];
debug("Called do_assertion(" . ($possible_object || 'undef') . ")\n");
if (ref($possible_object) and
ref($possible_object) ne 'Regexp' and
eval { $possible_object->isa('UNIVERSAL') })
{
debug(" [$possible_object] isa [" . ref($possible_object) . "]\n");
$possible_object->$$self(@_[1..$#_]);
}
else {
debug(" asserting [$self]"
. (@_ ? " on args " . join(', ', map { $_ || '<undef>' } @_) : '')
. "\n");
$$self->(@_);
}
}
sub to_string {
my $self = shift;
if (eval "require B::Deparse") {
$deparser ||= B::Deparse->new("-p");
return join '', "sub ", $deparser->coderef2text($$self);
}
else {
return "sub {
# If you had a working B::Deparse, you'd know what was in
# this subroutine.
}";
}
}
1;
__END__
=head1 NAME
Test::Unit::Assertion::CodeRef - A delayed evaluation assertion using a Coderef
=head1 SYNOPSIS
require Test::Unit::Assertion::CodeRef;
my $assert_eq =
Test::Unit::Assertion::CodeRef->new(sub {
$_[0] eq $_[1]
or Test::Unit::Failure->throw(-text =>
"Expected '$_[0]', got '$_[1]'\n");
});
$assert_eq->do_assertion('foo', 'bar');
Although this is how you'd use Test::Unit::Assertion::CodeRef
directly, it is more usually used indirectly via
Test::Unit::Test::assert, which instantiates a
Test::Unit::Assertion::CodeRef when passed a Coderef as its first
argument.
=head1 IMPLEMENTS
Test::Unit::Assertion::CodeRef implements the Test::Unit::Assertion
interface, which means it can be plugged into the Test::Unit::TestCase
and friends' C<assert> method with no ill effects.
=head1 DESCRIPTION
This class is used by the framework to allow us to do assertions in a
'functional' manner. It is typically used generated automagically in
code like:
$self->assert(sub {
$_[0] == $_[1]
or $self->fail("Expected $_[0], got $_[1]");
}, 1, 2);
(Note that if Damian Conway's Perl6 RFC for currying ever comes to
pass then we'll be able to do this as:
$self->assert(^1 == ^2 || $self->fail("Expected ^1, got ^2"), 1, 2)
which will be nice...)
If you have a working B::Deparse installed with your perl installation
then, if an assertion fails, you'll see a listing of the decompiled
coderef (which will be sadly devoid of comments, but should still be
useful)
=head1 AUTHOR
Copyright (c) 2001 Piers Cawley E<lt>pdcawley@iterative-software.comE<gt>.
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
=over 4
=item *
L<Test::Unit::TestCase>
=item *
L<Test::Unit::Assertion>
=back
|
