diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/00-compile.t | 50 | ||||
| -rw-r--r-- | t/lib/DistGen.pm | 602 | ||||
| -rw-r--r-- | t/release-pod-syntax.t | 14 | ||||
| -rw-r--r-- | t/simple.t | 137 |
4 files changed, 803 insertions, 0 deletions
diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..956ec06 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,50 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.040 + +use Test::More tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + + + +my @module_files = ( + 'Module/Build/Tiny.pm' +); + + + +# no fake home requested + +my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L<perlfaq8/How can I capture STDERR from an external command?> + my $stderr = IO::Handle->new; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + + + +is(scalar(@warnings), 0, 'no warnings found') if $ENV{AUTHOR_TESTING}; + + diff --git a/t/lib/DistGen.pm b/t/lib/DistGen.pm new file mode 100644 index 0000000..eee7375 --- /dev/null +++ b/t/lib/DistGen.pm @@ -0,0 +1,602 @@ +package DistGen; + +use strict; + +our $VERSION = '0.01'; +our $VERBOSE = 0; + +use Carp; + +use Cwd (); +use File::Basename (); +use File::Find (); +use File::Path (); +use File::Spec (); +use File::Temp (); +use IO::File (); +use Data::Dumper (); +use Exporter 5.57 'import'; + +our @EXPORT_OK = qw(undent); + +sub undent { + my ($string) = @_; + + my ($space) = $string =~ m/^(\s+)/; + $string =~ s/^$space//gm; + + return($string); +} + +sub chdir_all ($) { + # OS/2 has "current directory per disk", undeletable; + # doing chdir() to another disk won't change cur-dir of initial disk... + chdir('/') if $^O eq 'os2'; + chdir shift; +} + +######################################################################## + +my $orig_cwd = Cwd::cwd; +END { chdir_all($orig_cwd); } + +sub new { + my $self = bless {}, shift; + $self->reset(@_); +} + +sub reset { + my $self = shift; + my %options = @_; + + $options{name} ||= 'Simple'; + $options{dir} ||= File::Spec->rel2abs(File::Temp::tempdir( + DIR => File::Spec->curdir, CLEANUP => 1 + )); + + my %data = ( + %options, + ); + %$self = %data; + + $self->{filedata} = {}; + $self->{pending}{change} = {}; + + # start with a fresh, empty directory + if ( -d $self->dirname ) { + warn "Warning: Removing existing directory '@{[$self->dirname]}'\n"; + File::Path::rmtree( $self->dirname ); + } + File::Path::mkpath( $self->dirname ); + + $self->_gen_default_filedata(); + + return $self; +} + +sub remove { + my $self = shift; + $self->chdir_original if($self->did_chdir); + File::Path::rmtree( $self->dirname ); + return $self; +} + +sub revert { + my ($self, $file) = @_; + if ( defined $file ) { + delete $self->{filedata}{$file}; + delete $self->{pending}{$_}{$file} for qw/change remove/; + } + else { + delete $self->{filedata}{$_} for keys %{ $self->{filedata} }; + for my $pend ( qw/change remove/ ) { + delete $self->{pending}{$pend}{$_} for keys %{ $self->{pending}{$pend} }; + } + } + $self->_gen_default_filedata; +} + +sub _gen_default_filedata { + my $self = shift; + + # TODO maybe a public method like this (but with a better name?) + my $add_unless = sub { + my $self = shift; + my ($member, $data) = @_; + $self->add_file($member, $data) unless($self->{filedata}{$member}); + }; + + $self->$add_unless('Build.PL', undent(<<" ---")); + use lib 'inc'; use Module::Build::Tiny;Build_PL(\@ARGV); + --- + + my $module_filename = + join( '/', ('lib', split(/::/, $self->{name})) ) . '.pm'; + + my $module_name = $self->{name}; + (my $dist_name = $module_name) =~ s/::/-/g; + + $self->$add_unless($module_filename, undent(<<" ---")); + package $module_name; + + use vars qw( \$VERSION ); + \$VERSION = '0.01'; + + use strict; + + use Carp 0 (); + + 1; + + __END__ + + =head1 NAME + + $module_name - Perl extension for blah blah blah + + =head1 DESCRIPTION + + Stub documentation for $module_name. + + =head1 AUTHOR + + A. U. Thor, a.u.thor\@a.galaxy.far.far.away + + =cut + --- + + $self->$add_unless('t/basic.t', undent(<<" ---")); + use Test::More 0.23 tests => 1; + use strict; + + use $module_name; + ok 1; + --- + + $self->$add_unless('META.yml', undent(<<" ----")); + --- + name: $dist_name + version: 0.001 + author: + - 'David Golden <dagolden\@cpan.org>' + - 'Leon Timmermans <leont\@cpan.org>' + abstract: 'A testing dist' + license: perl + requires: + perl: 5.006 + Module::Build::Tiny: 0 + generated_by: Leon Timmermans + dynamic_config: 0 + meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 + ---- +} + +sub name { shift()->{name} } + +sub dirname { + my $self = shift; + my $dist = join( '-', split( /::/, $self->{name} ) ); + return File::Spec->catdir( $self->{dir}, $dist ); +} + +sub _real_filename { + my $self = shift; + my $filename = shift; + return File::Spec->catfile( split( /\//, $filename ) ); +} + +sub regen { + my $self = shift; + my %opts = @_; + + my $dist_dirname = $self->dirname; + + if ( $opts{clean} ) { + $self->clean() if -d $dist_dirname; + } else { + # TODO: This might leave dangling directories; e.g. if the removed file + # is 'lib/Simple/Simon.pm', the directory 'lib/Simple' will be left + # even if there are no files left in it. However, clean() will remove it. + my @files = keys %{$self->{pending}{remove}}; + foreach my $file ( @files ) { + my $real_filename = $self->_real_filename( $file ); + my $fullname = File::Spec->catfile( $dist_dirname, $real_filename ); + if ( -e $fullname ) { + 1 while File::Path::rmtree($fullname, 0, 0); + } + print "Unlinking pending file '$file'\n" if $VERBOSE; + delete( $self->{pending}{remove}{$file} ); + } + } + + foreach my $file ( keys( %{$self->{filedata}} ) ) { + my $real_filename = $self->_real_filename( $file ); + my $fullname = File::Spec->catfile( $dist_dirname, $real_filename ); + + if ( ! -e $fullname || + ( -e $fullname && $self->{pending}{change}{$file} ) ) { + + print "Changed file '$file'.\n" if $VERBOSE; + + my $dirname = File::Basename::dirname( $fullname ); + unless ( -d $dirname ) { + File::Path::mkpath( $dirname ) or do { + die "Can't create '$dirname'\n"; + }; + } + + if ( -e $fullname ) { + 1 while unlink( $fullname ); + } + + my $fh = IO::File->new(">$fullname") or do { + die "Can't write '$fullname'\n"; + }; + print $fh $self->{filedata}{$file}; + close( $fh ); + } + + delete( $self->{pending}{change}{$file} ); + } + + return $self; +} + +sub clean { + my $self = shift; + + my $here = Cwd::abs_path(); + my $there = File::Spec->rel2abs( $self->dirname() ); + + if ( -d $there ) { + chdir( $there ) or die "Can't change directory to '$there'\n"; + } else { + die "Distribution not found in '$there'\n"; + } + + my %names; + foreach my $file ( keys %{$self->{filedata}} ) { + my $filename = $self->_real_filename( $file ); + my $dirname = File::Basename::dirname( $filename ); + + $names{$filename} = 0; + + print "Splitting '$dirname'\n" if $VERBOSE; + my @dirs = File::Spec->splitdir( $dirname ); + while ( @dirs ) { + my $dir = ( scalar(@dirs) == 1 + ? $dirname + : File::Spec->catdir( @dirs ) ); + if (length $dir) { + print "Setting directory name '$dir' in \%names\n" if $VERBOSE; + $names{$dir} = 0; + } + pop( @dirs ); + } + } + + File::Find::finddepth( sub { + my $name = File::Spec->canonpath( $File::Find::name ); + + if ( not exists $names{$name} ) { + print "Removing '$name'\n" if $VERBOSE; + File::Path::rmtree( $_ ); + } + }, File::Spec->curdir ); + + + chdir_all( $here ); + return $self; +} + +sub add_file { + my $self = shift; + $self->change_file( @_ ); +} + +sub remove_file { + my $self = shift; + my $file = shift; + unless ( exists $self->{filedata}{$file} ) { + warn "Can't remove '$file': It does not exist.\n" if $VERBOSE; + } + delete( $self->{filedata}{$file} ); + $self->{pending}{remove}{$file} = 1; + return $self; +} + +sub change_file { + my $self = shift; + my $file = shift; + my $data = shift; + $self->{filedata}{$file} = $data; + $self->{pending}{change}{$file} = 1; + return $self; +} + +sub get_file { + my $self = shift; + my $file = shift; + exists($self->{filedata}{$file}) or croak("no such entry: '$file'"); + return $self->{filedata}{$file}; +} + +sub chdir_in { + my $self = shift; + $self->{original_dir} ||= Cwd::cwd; # only once! + my $dir = $self->dirname; + chdir($dir) or die "Can't chdir to '$dir': $!"; + return $self; +} +######################################################################## + +sub did_chdir { exists shift()->{original_dir} } + +######################################################################## + +sub chdir_original { + my $self = shift; + + my $dir = delete $self->{original_dir}; + chdir_all($dir) or die "Can't chdir to '$dir': $!"; + return $self; +} +######################################################################## + +1; + +# vim:ts=2:sw=2:et:sta +__END__ + + +=head1 NAME + +DistGen - Creates simple distributions for testing. + +=head1 SYNOPSIS + + use DistGen; + + # create distribution and prepare to test + my $dist = DistGen->new(name => 'Foo::Bar'); + $dist->chdir_in; + + # change distribution files + $dist->add_file('t/some_test.t', $contents); + $dist->change_file('MANIFEST.SKIP', $new_contents); + $dist->remove_file('t/some_test.t'); + $dist->regen; + + # undo changes and clean up extraneous files + $dist->revert; + $dist->clean; + + # start over as a new distribution + $dist->reset( name => 'Foo::Bar' ); + $dist->chdir_in; + +=head1 USAGE + +A DistGen object manages a set of files in a distribution directory. + +The C<new()> constructor initializes the object and creates an empty +directory for the distribution. It does not create files or chdir into +the directory. The C<reset()> method re-initializes the object in a +new directory with new parameters. It also does not create files or change +the current directory. + +Some methods only define the target state of the distribution. They do B<not> +make any changes to the filesystem: + + add_file + change_file + change_build_pl + remove_file + revert + +Other methods then change the filesystem to match the target state of +the distribution: + + clean + regen + remove + +Other methods are provided for a convenience during testing. The +most important is the one to enter the distribution directory: + + chdir_in + +=head1 API + +=head2 Constructors + +=head3 new() + +Create a new object and an empty directory to hold the distribution's files. +If no C<dir> option is provided, it defaults to MBTest->tmpdir, which sets +a different temp directory for Perl core testing and CPAN testing. + +The C<new> method does not write any files -- see L</regen()> below. + + my $dist = DistGen->new( + name => 'Foo::Bar', + dir => MBTest->tmpdir, + ); + +The parameters are as follows. + +=over + +=item name + +The name of the module this distribution represents. The default is +'Simple'. This should be a "Foo::Bar" (module) name, not a "Foo-Bar" +dist name. + +=item dir + +The (parent) directory in which to create the distribution directory. The +distribution will be created under this according to the "dist" form of C<name> +(e.g. "Foo-Bar".) Defaults to a temporary directory. + + $dist = DistGen->new( dir => '/tmp/MB-test' ); + $dist->regen; + + # distribution files have been created in /tmp/MB-test/Simple + +=back + +The following files are added as part of the default distribution: + + Build.PL + lib/Simple.pm # based on name parameter + t/basic.t + +The C<reset> method re-initializes the object as if it were generated +from a fresh call to C<new>. It takes the same optional parameters as C<new>. + + $dist->reset( name => 'Foo::Bar', xs => 0 ); + +=head2 Adding and editing files + +Note that C<$filename> should always be specified with unix-style paths, +and are relative to the distribution root directory, e.g. C<lib/Module.pm>. + +No changes are made to the filesystem until the distribution is regenerated. + +=head3 add_file() + +Add a $filename containing $content to the distribution. + + $dist->add_file( $filename, $content ); + +=head3 change_file() + +Changes the contents of $filename to $content. No action is performed +until the distribution is regenerated. + + $dist->change_file( $filename, $content ); + +=head3 change_build_pl() + +A wrapper around change_file specifically for setting Build.PL. Instead +of file C<$content>, it takes a hash-ref of Module::Build constructor +arguments: + + $dist->change_build_pl( + { + module_name => $dist->name, + dist_version => '3.14159265', + license => 'perl', + create_readme => 1, + } + ); + +=head3 get_file + +Retrieves the target contents of C<$filename>. + + $content = $dist->get_file( $filename ); + +=head3 remove_file() + +Removes C<$filename> from the distribution. + + $dist->remove_file( $filename ); + +=head3 revert() + +Returns the object to its initial state, or given a $filename it returns that +file to its initial state if it is one of the built-in files. + + $dist->revert; + $dist->revert($filename); + +=head2 Changing the distribution directory + +These methods immediately affect the filesystem. + +=head3 regen() + +Regenerate all missing or changed files. Also deletes any files +flagged for removal with remove_file(). + + $dist->regen(clean => 1); + +If the optional C<clean> argument is given, it also calls C<clean>. These +can also be chained like this, instead: + + $dist->clean->regen; + +=head3 clean() + +Removes any files that are not part of the distribution. + + $dist->clean; + +=head3 remove() + +Changes back to the original directory and removes the distribution +directory (but not the temporary directory set during C<new()>). + + $dist = DistGen->new->chdir->regen; + # ... do some testing ... + + $dist->remove->chdir_in->regen; + # ... do more testing ... + +This is like a more aggressive form of C<clean>. Generally, calling C<clean> +and C<regen> should be sufficient. + +=head2 Changing directories + +=head3 chdir_in + +Change directory into the dist root. + + $dist->chdir_in; + +=head3 chdir_original + +Returns to whatever directory you were in before chdir_in() (regardless +of the cwd.) + + $dist->chdir_original; + +=head2 Command-line helpers + +These use Module::Build->run_perl_script() to ensure that Build.PL or Build are +run in a separate process using the current perl interpreter. (Module::Build +is loaded on demand). They also ensure appropriate naming for operating +systems that require a suffix for Build. + +=head2 Properties + +=head3 name() + +Returns the name of the distribution. + + $dist->name: # e.g. Foo::Bar + +=head3 dirname() + +Returns the directory where the distribution is created. + + $dist->dirname; # e.g. t/_tmp/Simple + +=head2 Functions + +=head3 undent() + +Removes leading whitespace from a multi-line string according to the +amount of whitespace on the first line. + + my $string = undent(" foo(\n bar => 'baz'\n )"); + $string eq "foo( + bar => 'baz' + )"; + +=cut + diff --git a/t/release-pod-syntax.t b/t/release-pod-syntax.t new file mode 100644 index 0000000..cdd6a6c --- /dev/null +++ b/t/release-pod-syntax.t @@ -0,0 +1,14 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff --git a/t/simple.t b/t/simple.t new file mode 100644 index 0000000..fe86c71 --- /dev/null +++ b/t/simple.t @@ -0,0 +1,137 @@ +#! perl +use strict; +use warnings; +use Config; +use ExtUtils::CBuilder; +use File::Spec::Functions 0 qw/catdir catfile/; +use IPC::Open2; +use Test::More 0.88; +use lib 't/lib'; +use DistGen qw/undent/; +use XSLoader; + +local $ENV{PERL_INSTALL_QUIET}; +local $ENV{PERL_MB_OPT}; + +#--------------------------------------------------------------------------# +# fixtures +#--------------------------------------------------------------------------# + +my $dist = DistGen->new(name => 'Foo::Bar'); +$dist->chdir_in; +$dist->add_file('share/file.txt', 'FooBarBaz'); +$dist->add_file('script/simple', undent(<<' ---')); + #!perl + use Foo::Bar; + print Simple->VERSION . "\n"; + --- +my $has_compiler = ExtUtils::CBuilder->new->have_compiler(); +$dist->add_file('lib/Simple.xs', undent(<<' ---')) if $has_compiler; + #define PERL_NO_GET_CONTEXT + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + + MODULE = Simple PACKAGE = Simple + + const char* + foo() + CODE: + RETVAL = "Hello World!\n"; + OUTPUT: + RETVAL + --- + +$dist->regen; + +my $interpreter = ($Config{startperl} eq $^X ) + ? qr/#!\Q$^X\E/ + : qr/(?:#!\Q$^X\E|\Q$Config{startperl}\E)/; +my ($guts, $ec); + +sub _mod2pm { (my $mod = shift) =~ s{::}{/}g; return "$mod.pm" } +sub _path2mod { (my $pm = shift) =~ s{/}{::}g; return substr $pm, 5, -3 } +sub _mod2dist { (my $mod = shift) =~ s{::}{-}g; return $mod; } +sub _slurp { do { local (@ARGV,$/)=$_[0]; <> } } + +#--------------------------------------------------------------------------# +# configure +#--------------------------------------------------------------------------# + +{ + is(system($^X, 'Build.PL', '--install_base=install'), 0, 'Ran Build.PL'); + ok( -f 'Build', "Build created" ); + if ($^O eq 'MSWin32') { + ok( -f 'Build.bat', 'Build is executable'); + } + else { + ok( -x 'Build', "Build is executable" ); + } + + open my $fh, "<", "Build"; + my $line = <$fh>; + + like( $line, qr{\A$interpreter}, "Build has shebang line with \$^X" ); + ok( -f '_build_params', "_build_params created" ); +} + +#--------------------------------------------------------------------------# +# build +#--------------------------------------------------------------------------# + +{ + ok( open2(my($in, $out), $^X, 'Build'), 'Could run Build' ); + my $output = do { local $/; <$in> }; + like( $output, qr{lib/Foo/Bar\.pm}, 'Build output looks correctly'); + ok( -d 'blib', "created blib" ); + ok( -d 'blib/lib', "created blib/lib" ); + ok( -d 'blib/script', "created blib/script" ); + + # check pm + my $pmfile = _mod2pm($dist->name); + ok( -f 'blib/lib/' . $pmfile, "$dist->{name} copied to blib" ); + is( _slurp("lib/$pmfile"), _slurp("blib/lib/$pmfile"), "pm contents are correct" ); + is((stat "blib/lib/$pmfile")[2] & 0222, 0, "pm file in blib is readonly" ); + + # check bin + ok( -f 'blib/script/simple', "bin/simple copied to blib" ); + like( _slurp("blib/script/simple"), '/' .quotemeta(_slurp("blib/script/simple")) . "/", "blib/script/simple contents are correct" ); + if ($^O eq 'MSWin32') { + ok( -f "blib/script/simple.bat", "blib/script/simple is executable"); + } + else { + ok( -x "blib/script/simple", "blib/script/simple is executable" ); + } + is((stat "blib/script/simple")[2] & 0222, 0, "script in blib is readonly" ); + if ($^O ne 'MSWin32') { + open my $fh, "<", "blib/script/simple"; + my $line = <$fh>; + like( $line, qr{\A$interpreter}, "blib/script/simple has shebang line with \$^X" ); + } + + require blib; + blib->import; + if (eval { require File::ShareDir }) { + ok( -d File::ShareDir::dist_dir('Foo-Bar'), 'sharedir has been made'); + ok( -f File::ShareDir::dist_file('Foo-Bar', 'file.txt'), 'sharedir file has been made'); + } + ok( -d catdir(qw/blib lib auto share dist Foo-Bar/), 'sharedir has been made'); + ok( -f catfile(qw/blib lib auto share dist Foo-Bar file.txt/), 'sharedir file has been made'); + + if ($has_compiler) { + XSLoader::load('Simple'); + is(Simple::foo(), "Hello World!\n", 'Can run XSub Simple::foo'); + } +} + +{ + ok( open2(my($in, $out), $^X, Build => 'install'), 'Could run Build install' ); + my $output = do { local $/; <$in> }; + my $filename = catfile(qw/install lib perl5/, ($has_compiler? $Config{archname} : () ), qw/Foo Bar.pm/); + like($output, qr/Installing \Q$filename/, 'Build install output looks correctly'); + + ok( -f $filename, 'Module is installed'); + ok( -f 'install/bin/simple', 'Script is installed'); +} + +done_testing; |