r38916 - in /trunk/libmoosex-types-perl: ./ debian/ inc/Module/ inc/Module/Install/ lib/MooseX/ lib/MooseX/Types/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Mon Jun 29 15:27:29 UTC 2009
Author: jawnsy-guest
Date: Mon Jun 29 15:27:23 2009
New Revision: 38916
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38916
Log:
No release necessary
* New upstream release
+ Now uses an older Module::Install version (0.91 -> 0.88)
+ Use throw_exception instead of croak
+ Some more tests
Modified:
trunk/libmoosex-types-perl/Changes
trunk/libmoosex-types-perl/META.yml
trunk/libmoosex-types-perl/debian/changelog
trunk/libmoosex-types-perl/inc/Module/AutoInstall.pm
trunk/libmoosex-types-perl/inc/Module/Install.pm
trunk/libmoosex-types-perl/inc/Module/Install/AutoInstall.pm
trunk/libmoosex-types-perl/inc/Module/Install/Base.pm
trunk/libmoosex-types-perl/inc/Module/Install/Can.pm
trunk/libmoosex-types-perl/inc/Module/Install/Fetch.pm
trunk/libmoosex-types-perl/inc/Module/Install/Include.pm
trunk/libmoosex-types-perl/inc/Module/Install/Makefile.pm
trunk/libmoosex-types-perl/inc/Module/Install/Metadata.pm
trunk/libmoosex-types-perl/inc/Module/Install/Win32.pm
trunk/libmoosex-types-perl/inc/Module/Install/WriteAll.pm
trunk/libmoosex-types-perl/lib/MooseX/Types.pm
trunk/libmoosex-types-perl/lib/MooseX/Types/TypeDecorator.pm
trunk/libmoosex-types-perl/t/20_union_with_string_type.t
Modified: trunk/libmoosex-types-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/Changes?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/Changes (original)
+++ trunk/libmoosex-types-perl/Changes Mon Jun 29 15:27:23 2009
@@ -1,4 +1,10 @@
Revision history for MooseX-Types
+
+0.15 Sun Jun 27 15:50:00 EDT 2009
+ - Change all uses of croak in TypeDecorator to use the Moose
+ throw_exception method.
+ - More test cases for the union mixed string type issue, and
+ better handling of this in the | overload in TypeDecorator
0.14 Fri Jun 26 17:52:20 PDT 2009
- Fix union with string type
Modified: trunk/libmoosex-types-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/META.yml?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/META.yml (original)
+++ trunk/libmoosex-types-perl/META.yml Mon Jun 29 15:27:23 2009
@@ -10,7 +10,7 @@
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
+generated_by: 'Module::Install version 0.88'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -20,26 +20,6 @@
directory:
- inc
- t
-provides:
- MooseX::Types:
- file: lib/MooseX/Types.pm
- version: 0.14
- MooseX::Types::Base:
- file: lib/MooseX/Types/Base.pm
- MooseX::Types::CheckedUtilExports:
- file: lib/MooseX/Types/CheckedUtilExports.pm
- MooseX::Types::Combine:
- file: lib/MooseX/Types/Combine.pm
- MooseX::Types::Moose:
- file: lib/MooseX/Types/Moose.pm
- MooseX::Types::TypeDecorator:
- file: lib/MooseX/Types/TypeDecorator.pm
- MooseX::Types::UndefinedType:
- file: lib/MooseX/Types/UndefinedType.pm
- MooseX::Types::Util:
- file: lib/MooseX/Types/Util.pm
- MooseX::Types::Wrapper:
- file: lib/MooseX/Types/Wrapper.pm
requires:
Carp: 0
Carp::Clan: 6.00
@@ -51,4 +31,4 @@
perl: 5.8.0
resources:
license: http://dev.perl.org/licenses/
-version: 0.14
+version: 0.15
Modified: trunk/libmoosex-types-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/debian/changelog?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/debian/changelog (original)
+++ trunk/libmoosex-types-perl/debian/changelog Mon Jun 29 15:27:23 2009
@@ -1,3 +1,14 @@
+libmoosex-types-perl (0.15-1) UNRELEASED; urgency=low
+
+ No release necessary
+
+ * New upstream release
+ + Now uses an older Module::Install version (0.91 -> 0.88)
+ + Use throw_exception instead of croak
+ + Some more tests
+
+ -- Jonathan Yu <frequency at cpan.org> Mon, 29 Jun 2009 07:19:05 -0400
+
libmoosex-types-perl (0.14-1) unstable; urgency=low
* New upstream release
Modified: trunk/libmoosex-types-perl/inc/Module/AutoInstall.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/AutoInstall.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/AutoInstall.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/AutoInstall.pm Mon Jun 29 15:27:23 2009
@@ -670,7 +670,7 @@
# Load CPAN.pm and it's configuration
sub _load_cpan {
- return if $CPAN::VERSION and $CPAN::Config and not @_;
+ return if $CPAN::VERSION and not @_;
require CPAN;
if ( $CPAN::HandleConfig::VERSION ) {
# Newer versions of CPAN have a HandleConfig module
Modified: trunk/libmoosex-types-perl/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install.pm Mon Jun 29 15:27:23 2009
@@ -28,7 +28,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.91';
+ $VERSION = '0.88';
# Storage for the pseudo-singleton
$MAIN = undef;
Modified: trunk/libmoosex-types-perl/inc/Module/Install/AutoInstall.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/AutoInstall.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/AutoInstall.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/AutoInstall.pm Mon Jun 29 15:27:23 2009
@@ -2,13 +2,13 @@
package Module::Install::AutoInstall;
use strict;
-use Module::Install::Base ();
+use Module::Install::Base;
-use vars qw{$VERSION @ISA $ISCORE};
+use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
$ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
}
sub AutoInstall { $_[0] }
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Base.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Base.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Base.pm Mon Jun 29 15:27:23 2009
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.88';
}
# Suspend handler for "redefined" warnings
@@ -13,34 +13,42 @@
$SIG{__WARN__} = sub { $w };
}
-#line 42
+### This is the ONLY module that shouldn't have strict on
+# use strict;
+
+#line 45
sub new {
- my $class = shift;
- unless ( defined &{"${class}::call"} ) {
- *{"${class}::call"} = sub { shift->_top->call(@_) };
+ my ($class, %args) = @_;
+
+ foreach my $method ( qw(call load) ) {
+ next if defined &{"$class\::$method"};
+ *{"$class\::$method"} = sub {
+ shift()->_top->$method(@_);
+ };
}
- unless ( defined &{"${class}::load"} ) {
- *{"${class}::load"} = sub { shift->_top->load(@_) };
- }
- bless { @_ }, $class;
+
+ bless( \%args, $class );
}
-#line 61
+#line 66
sub AUTOLOAD {
+ my $self = shift;
local $@;
- my $func = eval { shift->_top->autoload } or return;
- goto &$func;
+ my $autoload = eval {
+ $self->_top->autoload
+ } or return;
+ goto &$autoload;
}
-#line 75
+#line 83
sub _top {
$_[0]->{_top};
}
-#line 90
+#line 98
sub admin {
$_[0]->_top->{admin}
@@ -48,7 +56,7 @@
Module::Install::Base::FakeAdmin->new;
}
-#line 106
+#line 114
sub is_admin {
$_[0]->admin->VERSION;
@@ -75,4 +83,4 @@
1;
-#line 154
+#line 162
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Can.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Can.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Can.pm Mon Jun 29 15:27:23 2009
@@ -2,16 +2,16 @@
package Module::Install::Can;
use strict;
-use Config ();
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
+use Module::Install::Base;
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
-use vars qw{$VERSION @ISA $ISCORE};
+use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
$ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
}
# check if we can load some module
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Fetch.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Fetch.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Fetch.pm Mon Jun 29 15:27:23 2009
@@ -2,13 +2,13 @@
package Module::Install::Fetch;
use strict;
-use Module::Install::Base ();
+use Module::Install::Base;
-use vars qw{$VERSION @ISA $ISCORE};
+use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
$ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
}
sub get_file {
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Include.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Include.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Include.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Include.pm Mon Jun 29 15:27:23 2009
@@ -2,13 +2,13 @@
package Module::Install::Include;
use strict;
-use Module::Install::Base ();
+use Module::Install::Base;
-use vars qw{$VERSION @ISA $ISCORE};
+use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
$ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
}
sub include {
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Makefile.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Makefile.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Makefile.pm Mon Jun 29 15:27:23 2009
@@ -2,14 +2,14 @@
package Module::Install::Makefile;
use strict 'vars';
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
+use Module::Install::Base;
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
$ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Metadata.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Metadata.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Metadata.pm Mon Jun 29 15:27:23 2009
@@ -2,17 +2,18 @@
package Module::Install::Metadata;
use strict 'vars';
-use Module::Install::Base ();
+use Module::Install::Base;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
+ @ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
+ mymeta
};
my @scalar_keys = qw{
@@ -439,21 +440,21 @@
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
+ 'under the same (?:terms|license) as perl itself' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s{\s+}{\\s+}g;
@@ -502,17 +503,6 @@
my $module = shift @requires;
my $version = shift @requires;
$self->requires( $module => $version );
- }
-}
-
-sub test_requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->test_requires( $module => $version );
}
}
@@ -526,8 +516,7 @@
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
- # Numify
- $v = $v + 0;
+ $v = $v + 0; # Numify
}
return $v;
}
@@ -537,56 +526,21 @@
######################################################################
-# MYMETA Support
+# MYMETA.yml Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
-sub write_mymeta_yaml {
- my $self = shift;
+sub write_mymeta {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return unless -f 'META.yml';
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.yml\n";
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
-}
-
-sub write_mymeta_json {
- my $self = shift;
-
- # We need JSON to write the MYMETA.json file
- unless ( eval { require JSON; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.json\n";
- Module::Install::_write(
- 'MYMETA.json',
- JSON->new->pretty(1)->canonical->encode($meta),
- );
-}
-
-sub _write_mymeta_data {
- my $self = shift;
-
- # If there's no existing META.yml there is nothing we can do
- return undef unless -f 'META.yml';
-
- # We need Parse::CPAN::Meta to load the file
- unless ( eval { require Parse::CPAN::Meta; 1; } ) {
- return undef;
}
# Merge the perl version into the dependencies
@@ -604,7 +558,7 @@
}
# Load the advisory META.yml file
- my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my @yaml = YAML::Tiny::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
@@ -618,7 +572,9 @@
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
- return $meta;
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
1;
Modified: trunk/libmoosex-types-perl/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/Win32.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/Win32.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/Win32.pm Mon Jun 29 15:27:23 2009
@@ -2,12 +2,12 @@
package Module::Install::Win32;
use strict;
-use Module::Install::Base ();
+use Module::Install::Base;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
+ $VERSION = '0.88';
+ @ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
Modified: trunk/libmoosex-types-perl/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/inc/Module/Install/WriteAll.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/inc/Module/Install/WriteAll.pm (original)
+++ trunk/libmoosex-types-perl/inc/Module/Install/WriteAll.pm Mon Jun 29 15:27:23 2009
@@ -2,11 +2,11 @@
package Module::Install::WriteAll;
use strict;
-use Module::Install::Base ();
+use Module::Install::Base;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';;
+ $VERSION = '0.88';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -41,18 +41,8 @@
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
- if ( $args{meta} ) {
- $self->Meta->write;
- }
-
- # Experimental support for MYMETA
- if ( $ENV{X_MYMETA} ) {
- if ( $ENV{X_MYMETA} eq 'JSON' ) {
- $self->Meta->write_mymeta_json;
- } else {
- $self->Meta->write_mymeta_yaml;
- }
- }
+ $self->Meta->write if $args{meta};
+ $self->Meta->write_mymeta if $self->mymeta;
return 1;
}
Modified: trunk/libmoosex-types-perl/lib/MooseX/Types.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/lib/MooseX/Types.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/lib/MooseX/Types.pm (original)
+++ trunk/libmoosex-types-perl/lib/MooseX/Types.pm Mon Jun 29 15:27:23 2009
@@ -20,7 +20,7 @@
use namespace::clean -except => [qw( meta )];
use 5.008;
-our $VERSION = '0.14';
+our $VERSION = '0.15';
my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
=head1 SYNOPSIS
Modified: trunk/libmoosex-types-perl/lib/MooseX/Types/TypeDecorator.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/lib/MooseX/Types/TypeDecorator.pm?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/lib/MooseX/Types/TypeDecorator.pm (original)
+++ trunk/libmoosex-types-perl/lib/MooseX/Types/TypeDecorator.pm Mon Jun 29 15:27:23 2009
@@ -24,10 +24,19 @@
## is needed for syntax compatibility. Maybe someday we'll all just do
## Or[Str,Str,Int]
- my @tc = map {
- blessed $_ ? $_ :
- Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
- } @_;
+ my @args = @_[0,1]; ## arg 3 is special, see the overload docs.
+ my @tc = grep {blessed $_} map {
+ blessed $_ ? $_ :
+ Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
+ || __PACKAGE__->_throw_error( "$_ is not a type constraint")
+ } @args;
+
+ ( scalar @tc == scalar @args)
+ || __PACKAGE__->_throw_error(
+ "one of your type constraints is bad. Passed: ". join(', ', @args) ." Got: ". join(', ', @tc));
+
+ ( scalar @tc >= 2 )
+ || __PACKAGE__->_throw_error("You must pass in at least 2 type names to make a union");
my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
return Moose::Util::TypeConstraints::register_type_constraint($union);
@@ -67,12 +76,12 @@
## stub in case we'll need to handle these types differently
return bless {'__type_constraint'=>$arg}, $class;
} elsif(blessed $arg) {
- croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg;
+ __PACKAGE__->_throw_error("Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg);
} else {
- croak "Argument cannot be '$arg'";
+ __PACKAGE__->_throw_error("Argument cannot be '$arg'");
}
} else {
- croak "This method [new] requires a single argument.";
+ __PACKAGE__->_throw_error("This method [new] requires a single argument.");
}
}
@@ -90,7 +99,7 @@
}
return $self->{__type_constraint};
} else {
- croak 'cannot call __type_constraint as a class method';
+ __PACKAGE__->_throw_error('cannot call __type_constraint as a class method');
}
}
@@ -113,6 +122,7 @@
}
}
+
=head2 can
handle $self->can since AUTOLOAD can't.
@@ -145,6 +155,18 @@
}
}
+=head2 _throw_error
+
+properly delegate error messages
+
+=cut
+
+sub _throw_error {
+ shift;
+ require Moose;
+ unshift @_, 'Moose';
+ goto &Moose::throw_error;
+}
=head2 DESTROY
@@ -176,7 +198,7 @@
eval {
$return = $self->__type_constraint->$method(@args);
}; if($@) {
- croak $@;
+ __PACKAGE__->_throw_error($@);
} else {
return $return;
}
Modified: trunk/libmoosex-types-perl/t/20_union_with_string_type.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmoosex-types-perl/t/20_union_with_string_type.t?rev=38916&op=diff
==============================================================================
--- trunk/libmoosex-types-perl/t/20_union_with_string_type.t (original)
+++ trunk/libmoosex-types-perl/t/20_union_with_string_type.t Mon Jun 29 15:27:23 2009
@@ -2,20 +2,49 @@
use strict;
use warnings;
-use Test::More tests => 1;
+use Test::More tests => 14;
my $exception;
{
package TypeLib;
- use MooseX::Types -declare => [qw( MyUnionType MyStr )];
- use MooseX::Types::Moose qw(Str Item);
+ use MooseX::Types -declare => [qw( MyUnionType Test1 Test2 Test3 MyStr )];
+ use MooseX::Types::Moose qw(Str Int Item Object);
subtype MyUnionType, as Str|'Int';
subtype MyStr, as Str;
eval { coerce MyStr, from Item, via {"$_"} };
- $exception = $@;
+ my $exception = $@;
+
+ Test::More::ok !$@, 'types are not mutated by union with a string type';
+
+ subtype Test1,
+ as Int | 'ArrayRef[Int]';
+
+ Test::More::ok Test1->check(1), '1 is an Int';
+ Test::More::ok !Test1->check('a'), 'a is not an Int';
+ Test::More::ok Test1->check([1, 2, 3]), 'Passes ArrayRef';
+ Test::More::ok !Test1->check([1, 'a', 3]), 'Fails ArrayRef with a letter';
+ Test::More::ok !Test1->check({a=>1}), 'fails wrong ref type';
+
+ eval {
+ subtype Test2,
+ as Int | 'IDONTEXIST';
+ };
+
+ my $check = $@;
+
+ Test::More::ok $@, 'Got an error for bad Type';
+ Test::More::like $check, qr/IDONTEXIST is not a type constraint/, 'correct error';
+
+ my $obj = subtype Test3,
+ as Int | 'ArrayRef[Int]' | Object;
+
+ Test::More::ok Test3->check(1), '1 is an Int';
+ Test::More::ok !Test3->check('a'), 'a is not an Int';
+ Test::More::ok Test3->check([1, 2, 3]), 'Passes ArrayRef';
+ Test::More::ok !Test3->check([1, 'a', 3]), 'Fails ArrayRef with a letter';
+ Test::More::ok !Test3->check({a=>1}), 'fails wrong ref type';
+ Test::More::ok Test3->check($obj), 'Union allows Object';
}
-
-ok !$@, 'types are not mutated by union with a string type';
More information about the Pkg-perl-cvs-commits
mailing list