-
Notifications
You must be signed in to change notification settings - Fork 14
/
30_method.t
122 lines (97 loc) · 3.94 KB
/
30_method.t
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
#!/usr/bin/perl
# Test the RPC::XML::Method class
use strict;
use vars qw($obj $obj2 $flag $dir $tmp);
use File::Spec;
use Test;
use RPC::XML::Procedure;
BEGIN { plan tests => 25 }
(undef, $dir, undef) = File::Spec->splitpath($0);
# The organization of the test suites is such that we assume anything that
# runs before the current suite is 100%. Thus, no consistency checks on
# any other classes are done, only on the data and return values of this
# class under consideration, RPC::XML::Method. Thus, we are not testing any
# part of the RPC::XML::Server class here. Only the code for managing methods.
# Tests 1-3: Basic new() success, simple accessors and successful calling
$obj = RPC::XML::Method->new({ name => 'test.test',
signature => [ 'int' ],
code => sub { $flag = 1; } });
if (ref($obj) eq 'RPC::XML::Method')
{
ok(1); # Signal that one passed
ok(($obj->name() eq 'test.test') &&
(scalar(@{$obj->signature}) == 1) &&
($obj->signature->[0] eq 'int'));
$flag = 0;
eval { $obj->code->(); };
ok(! $@ and $flag);
ok($obj->is_valid);
}
else
{
ok(0); # Signal failure
ok(0); # These two cannot run if the first one fails
ok(0);
ok(0);
}
# 5: This should fail due to missing information (the signature)
$obj = RPC::XML::Method->new({ name => 'test.test2',
code => sub { $flag = 2; } });
ok(! ref($obj));
# 6: This one fails because the signatures have a collision
$obj = RPC::XML::Method->new({ name => 'test.test2',
signature => [ 'int int',
'string int' ],
code => sub { $flag = 2; } });
ok(! ref($obj));
# 7: This file will not load due to missing required information
$obj = RPC::XML::Method->new(File::Spec->catfile($dir, 'meth_bad_1.xpl'));
ok(! ref($obj) and $obj =~ /missing/i);
# 8: This file will not load due to an XML parsing error
$obj = RPC::XML::Method->new(File::Spec->catfile($dir, 'meth_bad_2.xpl'));
ok(! ref($obj) and $obj =~ /error parsing/i);
# 9: And the third bowl of porridge was _just_ _right_...
$obj = RPC::XML::Method->new(File::Spec->catfile($dir, 'meth_good_1.xpl'));
ok(ref $obj);
# 10: Check the basics
ok(ref($obj) and $obj->name() and scalar(@{$obj->signature}) and
$obj->version() and $obj->help());
# 11: Is code() the type of ref we expect?
ok(ref($obj) and (ref($obj->code) eq 'CODE'));
# 12: This looks more complex than it is. The code returns this specific key:
ok($obj->code->({ method_name => $obj->name }) eq $obj->name);
# Time to test cloning
$obj2 = $obj->clone;
# 13: Did it?
ok(ref($obj2) eq ref($obj));
# 14: Primary accessors/data
ok(($obj->name() eq $obj2->name()) and
($obj->version() eq $obj2->version()) and
($obj->help() eq $obj2->help()));
# 15: Are the actual listrefs of signatures different?
ok($obj->signature() ne $obj2->signature());
# 16: And yet, the contents are the same?
ok((@{$obj->signature} == @{$obj2->signature}) and
# There's only one signature in the list
($obj->signature->[0] eq $obj2->signature->[0]));
# 17: Lastly, and very importantly, the coderefs are still the same
ok($obj->code() eq $obj2->code());
undef $obj2; # Don't need it anymore
# Now let's play around with signatures a bit
# 18: Basic test of match_signature()
ok($obj->match_signature('') eq 'string');
# 19: Add a new signature, simple
ok(ref $obj->add_signature('int int'));
# 20: There should now be two
ok(scalar(@{$obj->{signature}}) == 2);
# 21: Does the new one match OK?
ok($obj->match_signature('int') eq 'int');
# 22: This addition should fail due to ambiguity
ok(! ref($tmp = $obj->add_signature([ 'double', 'int' ])));
# 23: But did it fail for the right reasons?
ok($tmp =~ /make_sig_table/);
# 24: Test deletion
ok(ref($obj->delete_signature('int int')));
# 25: Which means checking the count again
ok(scalar(@{$obj->{signature}}) == 1);
exit;