Changeset 25412 for lang/perl/Shika

Timestamp:

11/30/08 17:19:39 (4 years ago)

Author:

yappo

Message:

add subtype function

Location:

lang/perl/Shika/trunk

Files:

• lib/Shika/Devel/TypeConstraints.pm (modified) (2 diffs)
• t/050_devel/03_add_subtype.t (added)

lang/perl/Shika/trunk/lib/Shika/Devel/TypeConstraints.pm

@@ -2 +2 @@
 use strict;
 use warnings;
+
+sub import {
+    my $class  = shift;
+    my $caller = caller(0);
+
+    no strict 'refs';
+    *{"$caller\::subtype"} = \&_subtype;
+}
+
+my $SUBTYPE = +{};
+sub _subtype {
+    my($name, $code) = @_;
+    $SUBTYPE->{$name} = $code;
+}
 
 sub check_valid {
@@ -24 +38 @@
         }
         return;
+    }
+    if (exists $SUBTYPE->{$isa}) {
+        return $SUBTYPE->{$isa}->(@_);
     }
     defined $_[0] && ref($_[0]) eq $isa;