| Subject: | better support of caller, make base types work |
- now calls sub with goto, means that croak/carp will work correctly
(still does not work when checking return)
- corrected tests (now check for different values of $answer)
- SCALAR, HASH, ARRAY now work
Also attached patched distribution.
--
Alexandr Ciornii, http://chorny.net
| Subject: | signature.t.patch |
--- signature.t.dist Fri Nov 9 17:57:17 2007
+++ signature.t Tue Nov 20 18:58:51 2007
@@ -2,7 +2,7 @@
package main;
use warnings;
use Attribute::Signature;
- use Test::Simple tests => 100;
+ use Test::More tests => 102;
$^W = 0;
}
@@ -44,7 +44,7 @@
return $code->() * $code->();
}
-sub squarer : with('REF') returns('number') {
+sub squarer : with('SCALAR') returns('number') {
my $ref = shift;
return $$ref * $$ref;
}
@@ -174,6 +174,7 @@
my $answer;
eval { $answer = square(10) };
+ok(!$@);
ok($answer == 100, "square(10) should return 100: $@");
@@ -265,8 +266,8 @@
eval { squareh('four') };
ok($@, "squareh('four') should fail");
-eval { $answer = squareh({ n => 10}) };
-ok($answer == 100, "squareh({ n => 10 }) should return 100");
+eval { $answer = squareh({ n => 9}) };
+ok($answer == 81, "squareh({ n => 9 }) should return 81");
eval { squareh([]) };
ok($@, "squareh([]) should fail");
@@ -294,6 +295,7 @@
eval { squarea({}) };
ok($@, "squarea({}) should fail");
+$answer=0;
eval { $answer = squarea([10]) };
ok($answer == 100, "squarea([10]) should return 100");
@@ -326,6 +328,7 @@
eval { squarec(\10) };
ok($@, 'squarec(\10) should fail');
+$answer=0;
eval { $answer = squarec(sub { 10 }) };
ok($answer == 100, 'squarec(sub { 10 }) should return 100');
@@ -337,6 +340,7 @@
# Test squarer
+
eval { squarer() };
ok($@, "squarer() should fail");
@@ -349,8 +353,10 @@
eval { squarer([]) };
ok($@, "squarer([]) should fail");
-eval { $answer = squarer(\10) };
-ok($answer == 100, 'squarer(\10) should return 100');
+$answer=0;
+eval { $answer = squarer(\11) };
+ok(!$a,'squarer(\11) should succeed');
+is($answer,121, 'squarer(\11) should return 121');
eval { squarer(sub {}) };
ok($@, 'squarer(sub {}) should fail');
| Subject: | Attribute-Signature-1.02_01.tar.gz |
Message body not shown because it is not plain text.
| Subject: | Signature.pm.patch |
--- Signature.pm.dist Thu Nov 1 15:27:37 2007
+++ Signature.pm Wed Nov 7 21:05:04 2007
@@ -47,29 +47,37 @@
if ($attributes->{method}) {
croak("invalid number of arguments passed to method $subname");
} else {
- croak("invalid number of arguments passed to subroutine $subname");
+ croak("invalid number of arguments passed to subroutine $subname ($count passed, ".scalar(@$data)." required");
}
}
my $m = 0;
print "Comparisons\n" if $::AS_DEBUG;
print "\tSignature\tValue\n" if $::AS_DEBUG;
+ my @failed;
while($i <= $count) {
print "\t$data->[$i]\t\t$_[$i]\n" if $::AS_DEBUG;
last unless $data->[$i];
+ my $ok=0;
if (lc($data->[$i]) eq $data->[$i]) {
## here we are checking for little types
my $type = $data->[$i];
if (Attribute::Signature->can( $type )) {
if (Attribute::Signature->$type( $_[$i] )) {
- $m++;
+ $ok++;
}
}
- } elsif ((blessed($_[$i]) || string($_[$i])) && $_[$i]->isa( $data->[$i]) ) {
- $m++;
+ } elsif ((blessed($_[$i])) && $_[$i]->isa( $data->[$i]) ) {
+ # || string($_[$i])
+ $ok++;
} elsif (!blessed($_[$i]) && ref($_[$i]) eq $data->[$i]) {
- $m++;
+ $ok++;
}
+ if ($ok) {
+ $m++ ;
+ } else {
+ push @failed,$i;
+ }
$i++;
}
@@ -78,7 +86,7 @@
print "Out of band:\n\tCount\tMatched\n\t$count\t$m\n" if $::AS_DEBUG;
if ($m != $count) {
- croak("call to $subname does not match signature");
+ croak("call to $subname does not match signature (failed args:".join(',',@failed).")");
} else {
goto &$referent;
}