r58757 - in /branches/upstream/libmoosex-types-structured-perl/current: ./ inc/Module/ inc/Module/Install/ lib/MooseX/Meta/TypeConstraint/ lib/MooseX/Types/ t/ t/regressions/

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Wed Jun 2 11:45:46 UTC 2010


Author: ansgar-guest
Date: Wed Jun  2 11:45:31 2010
New Revision: 58757

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=58757
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-types-structured-perl (0.22)

Added:
    branches/upstream/libmoosex-types-structured-perl/current/t/regressions/
    branches/upstream/libmoosex-types-structured-perl/current/t/regressions/01-is_type_of.t
Modified:
    branches/upstream/libmoosex-types-structured-perl/current/Changes
    branches/upstream/libmoosex-types-structured-perl/current/MANIFEST
    branches/upstream/libmoosex-types-structured-perl/current/META.yml
    branches/upstream/libmoosex-types-structured-perl/current/Makefile.PL
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/AutoInstall.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/AutoInstall.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Base.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Can.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Fetch.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Include.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Makefile.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Metadata.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Win32.pm
    branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/WriteAll.pm
    branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Meta/TypeConstraint/Structured.pm
    branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Types/Structured.pm
    branches/upstream/libmoosex-types-structured-perl/current/t/12-error.t

Modified: branches/upstream/libmoosex-types-structured-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/Changes?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/Changes (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/Changes Wed Jun  2 11:45:31 2010
@@ -1,8 +1,12 @@
 Revision history for MooseX-Types-Structured
+
+0.22   01 June 2010
+        - Added tests to demonstrate type constraint equality problem
+          introduced in Moose 1.05
 
 0.21   26 March 2010
         - Removed unneed module from test
-	- additional contributed documentation fixes
+        - additional contributed documentation fixes
 
 0.20   04 February 2010
         - Add a new Map type. (Ricardo SIGNES)

Modified: branches/upstream/libmoosex-types-structured-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/MANIFEST?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/MANIFEST Wed Jun  2 11:45:31 2010
@@ -38,3 +38,4 @@
 t/11-overflow.t
 t/12-error.t
 t/bug-optional.t
+t/regressions/01-is_type_of.t

Modified: branches/upstream/libmoosex-types-structured-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/META.yml?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/META.yml Wed Jun  2 11:45:31 2010
@@ -10,7 +10,7 @@
 configure_requires:
   ExtUtils::MakeMaker: 6.42
 distribution_type: module
-generated_by: 'Module::Install version 0.95'
+generated_by: 'Module::Install version 0.98'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -22,10 +22,12 @@
     - t
 requires:
   Devel::PartialDump: 0.10
-  Moose: 0.63
-  MooseX::Types: 0.08
+  Moose: 1.06
+  MooseX::Types: 0.22
   Sub::Exporter: 0.982
+  Test::Exception: 0.27
+  Test::More: 0.70
   perl: 5.8.0
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.21
+version: 0.22

Modified: branches/upstream/libmoosex-types-structured-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/Makefile.PL?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/Makefile.PL (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/Makefile.PL Wed Jun  2 11:45:31 2010
@@ -8,8 +8,8 @@
 license 'perl';
 
 ## Module dependencies
-requires 'Moose' => '0.63';
-requires 'MooseX::Types' => '0.08';
+requires 'Moose' => '1.06';
+requires 'MooseX::Types' => '0.22';
 requires 'Devel::PartialDump' => '0.10';
 requires 'Sub::Exporter' => '0.982';
 
@@ -24,7 +24,7 @@
 ## Build README
 system 'pod2text lib/MooseX/Types/Structured.pm > README'
     if -e 'MANIFEST.SKIP';
-    
+
 ## Instructions to Module::Install
 auto_install;
 tests_recursive;

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/AutoInstall.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/AutoInstall.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/AutoInstall.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/AutoInstall.pm Wed Jun  2 11:45:31 2010
@@ -253,6 +253,8 @@
     # import to main::
     no strict 'refs';
     *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+    return (@Existing, @Missing);
 }
 
 sub _running_under {
@@ -815,4 +817,4 @@
 
 __END__
 
-#line 1069
+#line 1071

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install.pm Wed Jun  2 11:45:31 2010
@@ -32,7 +32,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.95';
+	$VERSION = '0.98';
 
 	# Storage for the pseudo-singleton
 	$MAIN    = undef;
@@ -127,6 +127,11 @@
 	#-------------------------------------------------------------
 
 	unless ( -f $self->{file} ) {
+		foreach my $key (keys %INC) {
+			delete $INC{$key} if $key =~ /Module\/Install/;
+		}
+
+		local $^W;
 		require "$self->{path}/$self->{dispatch}.pm";
 		File::Path::mkpath("$self->{prefix}/$self->{author}");
 		$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
@@ -135,12 +140,13 @@
 		goto &{"$self->{name}::import"};
 	}
 
+	local $^W;
 	*{"${who}::AUTOLOAD"} = $self->autoload;
 	$self->preload;
 
 	# Unregister loader and worker packages so subdirs can use them again
-	delete $INC{"$self->{file}"};
-	delete $INC{"$self->{path}.pm"};
+	delete $INC{'inc/Module/Install.pm'};
+	delete $INC{'Module/Install.pm'};
 
 	# Save to the singleton
 	$MAIN = $self;
@@ -159,7 +165,21 @@
 			# Delegate back to parent dirs
 			goto &$code unless $cwd eq $pwd;
 		}
-		$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+		unless ($$sym =~ s/([^:]+)$//) {
+			# XXX: it looks like we can't retrieve the missing function
+			# via $$sym (usually $main::AUTOLOAD) in this case.
+			# I'm still wondering if we should slurp Makefile.PL to
+			# get some context or not ...
+			my ($package, $file, $line) = caller;
+			die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+		}
 		my $method = $1;
 		if ( uc($method) eq $method ) {
 			# Do nothing
@@ -200,6 +220,7 @@
 
 	my $who = $self->_caller;
 	foreach my $name ( sort keys %seen ) {
+		local $^W;
 		*{"${who}::$name"} = sub {
 			${"${who}::AUTOLOAD"} = "${who}::$name";
 			goto &{"${who}::AUTOLOAD"};
@@ -210,12 +231,13 @@
 sub new {
 	my ($class, %args) = @_;
 
+	FindBin->again;
+
 	# ignore the prefix on extension modules built from top level.
 	my $base_path = Cwd::abs_path($FindBin::Bin);
 	unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
 		delete $args{prefix};
 	}
-
 	return $args{_self} if $args{_self};
 
 	$args{dispatch} ||= 'Admin';
@@ -268,8 +290,10 @@
 sub load_extensions {
 	my ($self, $path, $top) = @_;
 
+	my $should_reload = 0;
 	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
 		unshift @INC, $self->{prefix};
+		$should_reload = 1;
 	}
 
 	foreach my $rv ( $self->find_extensions($path) ) {
@@ -277,12 +301,13 @@
 		next if $self->{pathnames}{$pkg};
 
 		local $@;
-		my $new = eval { require $file; $pkg->can('new') };
+		my $new = eval { local $^W; require $file; $pkg->can('new') };
 		unless ( $new ) {
 			warn $@ if $@;
 			next;
 		}
-		$self->{pathnames}{$pkg} = delete $INC{$file};
+		$self->{pathnames}{$pkg} =
+			$should_reload ? delete $INC{$file} : $INC{$file};
 		push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
 	}
 

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/AutoInstall.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/AutoInstall.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/AutoInstall.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/AutoInstall.pm Wed Jun  2 11:45:31 2010
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -37,11 +37,24 @@
     $self->include('Module::AutoInstall');
     require Module::AutoInstall;
 
-    Module::AutoInstall->import(
+    my @features_require = Module::AutoInstall->import(
         (@config ? (-config => \@config) : ()),
         (@core   ? (-core   => \@core)   : ()),
         $self->features,
     );
+
+    my %seen;
+    my @requires = map @$_, map @$_, grep ref, $self->requires;
+    while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+        $seen{$mod}{$ver}++;
+    }
+
+    my @deduped;
+    while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+        push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+    }
+
+    $self->requires(@deduped);
 
     $self->makemaker_args( Module::AutoInstall::_make_args() );
 

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Base.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Base.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Base.pm Wed Jun  2 11:45:31 2010
@@ -4,7 +4,7 @@
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 }
 
 # Suspend handler for "redefined" warnings
@@ -51,12 +51,17 @@
 #line 106
 
 sub is_admin {
-	$_[0]->admin->VERSION;
+	! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
 }
 
 sub DESTROY {}
 
 package Module::Install::Base::FakeAdmin;
+
+use vars qw{$VERSION};
+BEGIN {
+	$VERSION = $Module::Install::Base::VERSION;
+}
 
 my $fake;
 
@@ -75,4 +80,4 @@
 
 1;
 
-#line 154
+#line 159

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Can.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Can.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Can.pm Wed Jun  2 11:45:31 2010
@@ -9,7 +9,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Fetch.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Fetch.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Fetch.pm Wed Jun  2 11:45:31 2010
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Include.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Include.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Include.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Include.pm Wed Jun  2 11:45:31 2010
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Makefile.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Makefile.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Makefile.pm Wed Jun  2 11:45:31 2010
@@ -4,10 +4,11 @@
 use strict 'vars';
 use ExtUtils::MakeMaker   ();
 use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -101,24 +102,26 @@
 	my ($self, %new_args) = @_;
 	my $args = ( $self->{makemaker_args} ||= {} );
 	foreach my $key (keys %new_args) {
-		if ($makemaker_argtype{$key} eq 'ARRAY') {
-			$args->{$key} = [] unless defined $args->{$key};
-			unless (ref $args->{$key} eq 'ARRAY') {
-				$args->{$key} = [$args->{$key}]
+		if ($makemaker_argtype{$key}) {
+			if ($makemaker_argtype{$key} eq 'ARRAY') {
+				$args->{$key} = [] unless defined $args->{$key};
+				unless (ref $args->{$key} eq 'ARRAY') {
+					$args->{$key} = [$args->{$key}]
+				}
+				push @{$args->{$key}},
+					ref $new_args{$key} eq 'ARRAY'
+						? @{$new_args{$key}}
+						: $new_args{$key};
 			}
-			push @{$args->{$key}},
-				ref $new_args{$key} eq 'ARRAY'
-					? @{$new_args{$key}}
-					: $new_args{$key};
-		}
-		elsif ($makemaker_argtype{$key} eq 'HASH') {
-			$args->{$key} = {} unless defined $args->{$key};
-			foreach my $skey (keys %{ $new_args{$key} }) {
-				$args->{$key}{$skey} = $new_args{$key}{$skey};
+			elsif ($makemaker_argtype{$key} eq 'HASH') {
+				$args->{$key} = {} unless defined $args->{$key};
+				foreach my $skey (keys %{ $new_args{$key} }) {
+					$args->{$key}{$skey} = $new_args{$key}{$skey};
+				}
 			}
-		}
-		elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
-			$self->makemaker_append($key => $new_args{$key});
+			elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+				$self->makemaker_append($key => $new_args{$key});
+			}
 		}
 		else {
 			if (defined $args->{$key}) {
@@ -178,28 +181,22 @@
 	$self->makemaker_args( INC => shift );
 }
 
-my %test_dir = ();
-
 sub _wanted_t {
-	/\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
 }
 
 sub tests_recursive {
 	my $self = shift;
-	if ( $self->tests ) {
-		die "tests_recursive will not work if tests are already defined";
-	}
 	my $dir = shift || 't';
 	unless ( -d $dir ) {
 		die "tests_recursive dir '$dir' does not exist";
 	}
-	%test_dir = ();
+	my %tests = map { $_ => 1 } split / /, ($self->tests || '');
 	require File::Find;
-	File::Find::find( \&_wanted_t, $dir );
-	if ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
-		File::Find::find( \&_wanted_t, 'xt' );
-	}
-	$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+	File::Find::find(
+        sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+        $dir
+    );
+	$self->tests( join ' ', sort keys %tests );
 }
 
 sub write {
@@ -251,6 +248,9 @@
 		$args->{test} = {
 			TESTS => (join ' ', grep {!$seen{$_}++} @tests),
 		};
+    } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+        # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+        # So, just ignore our xt tests here.
 	} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
 		$args->{test} = {
 			TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
@@ -297,13 +297,22 @@
 	# Remove any reference to perl, BUILD_REQUIRES doesn't support it
 	delete $args->{BUILD_REQUIRES}->{perl};
 
-	# Delete bundled dists from prereq_pm
-	my $subdirs = ($args->{DIR} ||= []);
+	# Delete bundled dists from prereq_pm, add it to Makefile DIR
+	my $subdirs = ($args->{DIR} || []);
 	if ($self->bundles) {
+		my %processed;
 		foreach my $bundle (@{ $self->bundles }) {
-			my ($file, $dir) = @$bundle;
-			push @$subdirs, $dir if -d $dir;
-			delete $build_prereq->{$file}; #Delete from build prereqs only
+			my ($mod_name, $dist_dir) = @$bundle;
+			delete $prereq->{$mod_name};
+			$dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+			if (not exists $processed{$dist_dir}) {
+				if (-d $dist_dir) {
+					# List as sub-directory to be processed by make
+					push @$subdirs, $dist_dir;
+				}
+				# Else do nothing: the module is already present on the system
+				$processed{$dist_dir} = undef;
+			}
 		}
 	}
 
@@ -356,9 +365,9 @@
 		. ($self->postamble || '');
 
 	local *MAKEFILE;
-	open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+	open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+	eval { flock MAKEFILE, LOCK_EX };
 	my $makefile = do { local $/; <MAKEFILE> };
-	close MAKEFILE or die $!;
 
 	$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
 	$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -378,7 +387,8 @@
 	# XXX - This is currently unused; not sure if it breaks other MM-users
 	# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
 
-	open  MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+	seek MAKEFILE, 0, SEEK_SET;
+	truncate MAKEFILE, 0;
 	print MAKEFILE  "$preamble$makefile$postamble" or die $!;
 	close MAKEFILE  or die $!;
 
@@ -402,4 +412,4 @@
 
 __END__
 
-#line 531
+#line 541

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Metadata.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Metadata.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Metadata.pm Wed Jun  2 11:45:31 2010
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
@@ -178,43 +178,6 @@
 	$self->{values}->{perl_version} = $version;
 }
 
-#Stolen from M::B
-my %license_urls = (
-    perl         => 'http://dev.perl.org/licenses/',
-    apache       => 'http://apache.org/licenses/LICENSE-2.0',
-    artistic     => 'http://opensource.org/licenses/artistic-license.php',
-    artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
-    lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
-    lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
-    lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
-    bsd          => 'http://opensource.org/licenses/bsd-license.php',
-    gpl          => 'http://opensource.org/licenses/gpl-license.php',
-    gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
-    gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
-    mit          => 'http://opensource.org/licenses/mit-license.php',
-    mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
-    open_source  => undef,
-    unrestricted => undef,
-    restrictive  => undef,
-    unknown      => undef,
-);
-
-sub license {
-	my $self = shift;
-	return $self->{values}->{license} unless @_;
-	my $license = shift or die(
-		'Did not provide a value to license()'
-	);
-	$self->{values}->{license} = $license;
-
-	# Automatically fill in license URLs
-	if ( $license_urls{$license} ) {
-		$self->resources( license => $license_urls{$license} );
-	}
-
-	return 1;
-}
-
 sub all_from {
 	my ( $self, $file ) = @_;
 
@@ -354,6 +317,9 @@
 	require ExtUtils::MM_Unix;
 	my ( $self, $file ) = @_;
 	$self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+	# for version integrity check
+	$self->makemaker_args( VERSION_FROM => $file );
 }
 
 sub abstract_from {
@@ -364,7 +330,7 @@
 			{ DISTNAME => $self->name },
 			'ExtUtils::MM_Unix'
 		)->parse_abstract($file)
-	 );
+	);
 }
 
 # Add both distribution and module name
@@ -479,42 +445,89 @@
 	}
 }
 
+#Stolen from M::B
+my %license_urls = (
+    perl         => 'http://dev.perl.org/licenses/',
+    apache       => 'http://apache.org/licenses/LICENSE-2.0',
+    apache_1_1   => 'http://apache.org/licenses/LICENSE-1.1',
+    artistic     => 'http://opensource.org/licenses/artistic-license.php',
+    artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
+    lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
+    lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
+    lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
+    bsd          => 'http://opensource.org/licenses/bsd-license.php',
+    gpl          => 'http://opensource.org/licenses/gpl-license.php',
+    gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
+    gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
+    mit          => 'http://opensource.org/licenses/mit-license.php',
+    mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
+    open_source  => undef,
+    unrestricted => undef,
+    restrictive  => undef,
+    unknown      => undef,
+);
+
+sub license {
+	my $self = shift;
+	return $self->{values}->{license} unless @_;
+	my $license = shift or die(
+		'Did not provide a value to license()'
+	);
+	$license = __extract_license($license) || lc $license;
+	$self->{values}->{license} = $license;
+
+	# Automatically fill in license URLs
+	if ( $license_urls{$license} ) {
+		$self->resources( license => $license_urls{$license} );
+	}
+
+	return 1;
+}
+
 sub _extract_license {
 	my $pod = shift;
 	my $matched;
 	return __extract_license(
 		($matched) = $pod =~ m/
-			(=head \d \s+ (?:licen[cs]e|licensing)\b.*?)
+			(=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
 			(=head \d.*|=cut.*|)\z
-		/ixms
+		/xms
 	) || __extract_license(
 		($matched) = $pod =~ m/
-			(=head \d \s+ (?:copyrights?|legal)\b.*?)
+			(=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
 			(=head \d.*|=cut.*|)\z
-		/ixms
+		/xms
 	);
 }
 
 sub __extract_license {
 	my $license_text = shift or return;
 	my @phrases      = (
-		'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
-		'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
-		'Artistic and GPL'                   => '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|the perl (?:\d )?programming language)' => 'perl', 1,
+		'(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+		'Artistic and GPL'                   => '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,
+		'GNU Free Documentation license'     => 'unrestricted', 1,
+		'GNU Affero General Public License'  => 'open_source',  1,
+		'(?:Free)?BSD license'               => 'bsd',          1,
+		'Artistic license'                   => 'artistic',     1,
+		'Apache (?:Software )?license'       => 'apache',       1,
+		'GPL'                                => 'gpl',          1,
+		'LGPL'                               => 'lgpl',         1,
+		'BSD'                                => 'bsd',          1,
+		'Artistic'                           => 'artistic',     1,
+		'MIT'                                => 'mit',          1,
+		'Mozilla Public License'             => 'mozilla',      1,
+		'Q Public License'                   => 'open_source',  1,
+		'OpenSSL License'                    => 'unrestricted', 1,
+		'SSLeay License'                     => 'unrestricted', 1,
+		'zlib License'                       => 'open_source',  1,
+		'proprietary'                        => 'proprietary',  0,
 	);
 	while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
 		$pattern =~ s#\s+#\\s+#gs;
@@ -522,6 +535,7 @@
 			return $license;
 		}
 	}
+	return '';
 }
 
 sub license_from {
@@ -602,8 +616,15 @@
 	return $v;
 }
 
-
-
+sub add_metadata {
+    my $self = shift;
+    my %hash = @_;
+    for my $key (keys %hash) {
+        warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+             "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+        $self->{values}->{$key} = $hash{$key};
+    }
+}
 
 
 ######################################################################

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Win32.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Win32.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/Win32.pm Wed Jun  2 11:45:31 2010
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';
+	$VERSION = '0.98';
 	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }

Modified: branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/WriteAll.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/WriteAll.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/inc/Module/Install/WriteAll.pm Wed Jun  2 11:45:31 2010
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.95';;
+	$VERSION = '0.98';
 	@ISA     = qw{Module::Install::Base};
 	$ISCORE  = 1;
 }

Modified: branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Meta/TypeConstraint/Structured.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Meta/TypeConstraint/Structured.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Meta/TypeConstraint/Structured.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Meta/TypeConstraint/Structured.pm Wed Jun  2 11:45:31 2010
@@ -232,9 +232,7 @@
 
 sub is_subtype_of {
     my ( $self, $type_or_name ) = @_;
-
     my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
-
     if ( $other->isa(__PACKAGE__) ) {
         if ( $other->type_constraints and $self->type_constraints ) {
             if ( $self->parent->is_a_type_of($other->parent) ) {
@@ -294,7 +292,8 @@
         $_ = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)
           for $self_type_constraint, $other_type_constraint;
 
-        $self_type_constraint->$op($other_type_constraint) or return;
+        my $result = $self_type_constraint->$op($other_type_constraint);
+        return unless $result;
     }
     
     return 1; ##If we get this far, everything is good.

Modified: branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Types/Structured.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Types/Structured.pm?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Types/Structured.pm (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/lib/MooseX/Types/Structured.pm Wed Jun  2 11:45:31 2010
@@ -11,7 +11,7 @@
 use Devel::PartialDump;
 use Scalar::Util qw(blessed);
 
-our $VERSION = '0.21';
+our $VERSION = '0.22';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME

Modified: branches/upstream/libmoosex-types-structured-perl/current/t/12-error.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/t/12-error.t?rev=58757&op=diff
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/t/12-error.t (original)
+++ branches/upstream/libmoosex-types-structured-perl/current/t/12-error.t Wed Jun  2 11:45:31 2010
@@ -23,19 +23,19 @@
 ## Let's check all the expected validation errors for tuple
 
 like $simple_tuple->validate({a=>1,b=>2}),
- qr/Validation failed for 'simple_tuple' failed with value { a: 1, b: 2 }/,
+ qr/Validation failed for 'simple_tuple' with value { a: 1, b: 2 }/,
  'Wrong basic type';
 
 like $simple_tuple->validate(['a','b']),
- qr/failed for 'simple_tuple' failed with value \[ "a", "b" \]/,
+ qr/failed for 'simple_tuple' with value \[ "a", "b" \]/,
  'Correctly failed due to "a" not an Int';
  
 like $simple_tuple->validate([1,$simple_tuple]),
- qr/Validation failed for 'simple_tuple' failed with value \[ 1, MooseX::Meta::TypeConstraint::Structured/,
+ qr/Validation failed for 'simple_tuple' with value \[ 1, MooseX::Meta::TypeConstraint::Structured/,
  'Correctly failed due to object not a Str';
 
 like $simple_tuple->validate([1]),
- qr/Validation failed for 'Str' failed with value NULL/,
+ qr/Validation failed for 'Str' with value NULL/,
  'Not enought values';
 
 like $simple_tuple->validate([1,'hello','too many']),
@@ -45,19 +45,19 @@
 ## And the same thing for dicts [name=>Str,age=>Int]
 
 like $simple_dict->validate([1,2]),
- qr/ failed with value \[ 1, 2 \]/,
+ qr/ with value \[ 1, 2 \]/,
  'Wrong basic type';
  
 like $simple_dict->validate({name=>'John',age=>'a'}),
- qr/failed for 'Int' failed with value a/,
+ qr/failed for 'Int' with value a/,
  'Correctly failed due to age not an Int';
  
 like $simple_dict->validate({name=>$simple_dict,age=>1}),
- qr/failed with value { age: 1, name: MooseX:/,
+ qr/with value { age: 1, name: MooseX:/,
  'Correctly failed due to object not a Str';
 
 like $simple_dict->validate({name=>'John'}),
- qr/failed for 'Int' failed with value NULL/,
+ qr/failed for 'Int' with value NULL/,
  'Not enought values';
 
 like $simple_dict->validate({name=>'Vincent', age=>15,extra=>'morethanIneed'}),
@@ -70,15 +70,15 @@
  my $optional_dict = subtype 'optional_dict', as Dict[name=>Str,age=>Optional[Int]];
  
  like $optional_tuple->validate({a=>1,b=>2}),
- qr/Validation failed for 'optional_tuple' failed with value { a: 1, b: 2 }/,
+ qr/Validation failed for 'optional_tuple' with value { a: 1, b: 2 }/,
  'Wrong basic type';
 
 like $optional_tuple->validate(['a','b']),
- qr/failed for 'Int' failed with value a/,
+ qr/failed for 'Int' with value a/,
  'Correctly failed due to "a" not an Int';
  
 like $optional_tuple->validate([1,$simple_tuple]),
- qr/failed for 'MooseX::Types::Structured::Optional\[Str\]' failed with value MooseX/,
+ qr/failed for 'MooseX::Types::Structured::Optional\[Str\]' with value MooseX/,
  'Correctly failed due to object not a Str';
 
 like $optional_tuple->validate([1,'hello','too many']),
@@ -86,15 +86,15 @@
  'Too Many values';
 
 like $optional_dict->validate([1,2]),
- qr/ failed with value \[ 1, 2 \]/,
+ qr/ with value \[ 1, 2 \]/,
  'Wrong basic type';
  
 like $optional_dict->validate({name=>'John',age=>'a'}),
- qr/Validation failed for 'MooseX::Types::Structured::Optional\[Int\]' failed with value a/,
+ qr/Validation failed for 'MooseX::Types::Structured::Optional\[Int\]' with value a/,
  'Correctly failed due to age not an Int';
  
 like $optional_dict->validate({name=>$simple_dict,age=>1}),
- qr/failed with value { age: 1, name: MooseX:/,
+ qr/with value { age: 1, name: MooseX:/,
  'Correctly failed due to object not a Str';
 
 like $optional_dict->validate({name=>'Vincent', age=>15,extra=>'morethanIneed'}),

Added: branches/upstream/libmoosex-types-structured-perl/current/t/regressions/01-is_type_of.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-types-structured-perl/current/t/regressions/01-is_type_of.t?rev=58757&op=file
==============================================================================
--- branches/upstream/libmoosex-types-structured-perl/current/t/regressions/01-is_type_of.t (added)
+++ branches/upstream/libmoosex-types-structured-perl/current/t/regressions/01-is_type_of.t Wed Jun  2 11:45:31 2010
@@ -1,0 +1,70 @@
+BEGIN {
+	use strict;
+	use warnings;
+	use Test::More tests=>11;
+}
+
+{
+    package TypeLib;
+    use MooseX::Types::Structured qw(Dict Tuple);
+    use MooseX::Types::Moose qw(Int Str Item);
+    use MooseX::Types -declare => [qw(
+        MyDict1 MyDict2  MyDict4 
+    )];
+
+    subtype MyDict1,
+    as Dict[name=>Str, age=>Int];
+
+    subtype MyDict2,
+    as Dict[name=>Str, age=>Int];
+
+     subtype MyDict4,
+    as Dict[name=>Str, age=>Item];
+
+}
+
+BEGIN {
+    TypeLib->import(':all');
+}
+
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Structured qw(Dict Tuple);
+use MooseX::Types::Moose qw(Item Any);
+
+
+ok ( MyDict2->is_a_type_of(MyDict4),
+  'MyDict2 is_a_type_of MyDict4');
+
+ok ( MyDict1->is_subtype_of(MyDict4),
+  'MyDict1 is_subtype_of MyDict4');
+
+ok ( (Tuple[Tuple[ class_type('Paper'), class_type('Stone') ], Dict[]])->is_a_type_of( Tuple[Tuple[ Item, Item ], Dict[]] ),
+  "tuple of tuple" );
+
+ok ( (Tuple[Tuple[ class_type('Paper'), class_type('Stone') ], Dict[]])->is_a_type_of( Tuple[Tuple[ Item, Item ], Dict[]] ),
+  "tuple of tuple" );
+
+ok ( (Tuple[Tuple[ class_type('Paper'), class_type('Stone') ], Dict[]])->is_subtype_of( Tuple[Tuple[ Item, Item ], Dict[]] ),
+  "tuple of tuple" );
+
+my $item = subtype as 'Item';
+
+ok ( $item->is_subtype_of('Any'),
+  q[$item is subtype of 'Any']);
+
+ok ( Item->is_subtype_of('Any'),
+  q[Item is subtype of 'Any']);
+
+ok ( $item->is_subtype_of(Any),
+  q[Item is subtype of Any]);
+
+ok ( Item->is_subtype_of(Any),
+  q[Item is subtype of Any]);
+
+my $any = subtype as 'Any';
+
+ok ( ! $item->is_subtype_of($any),
+  q[$item is NOT a subtype of $any]);
+
+ok ( ! Item->is_subtype_of($any),
+  q[Item is NOT a subtype of $any]);




More information about the Pkg-perl-cvs-commits mailing list