Re: [PATCH] Module-Build-0.34 on OS/2

Thanks, Ilya.  Committed to the repository trunk.

David

On Sun, Aug 9, 2009 at 5:42 PM, Ilya Zakharevich<[email protected]> wrote:
> A lot of thanks for maintaining Module::Build.  The patches below make
> it pass the test suite on OS/2, and make it not leave temporary dirs
> in $TMP.
>
> Comments:
>
>  *) by default, makefiles use DOSISH shell, which would choke on '/' in
>    filenames.  So we switch to 'sh'.
>
>  *) OS/2 maintains "one current directory on a drive"; all of them are
>    not deletable.  So if current drive is D: and current directories
>    are c:/foo and d:/bar, then chdir('c:/baz') would make current
>    directories c:/baz and d:/bar, and the current drive C:.
>
>    As a result, "the old current directory" d:/bar is still "active",
>    and not deletable.  ===> we need an extra "chdir '/'" first...
>
>  *) On OS/2 by default we have only one user.  So `all users' have the
>    same HOME directory.  In particular, '~foo' is always present.
>
> Thanks again,
> Ilya
>
> --- ./lib/Module/Build/Compat.pm-pre    Tue Jul  7 13:59:10 2009
> +++ ./lib/Module/Build/Compat.pm        Sun Aug  9 13:10:36 2009
> @@ -318,7 +318,9 @@ sub fake_makefile {
>   my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
>   $unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
>
> -  my $maketext = <<"EOF";
> +  my $maketext = ($^O eq 'os2' ? "SHELL = sh\n\n" : '');
> +
> +  $maketext .= <<"EOF";
>  all : force_do_it
>        $perl $Build
>  realclean : force_do_it
> --- ./t/add_property.t-pre      Tue Jul  7 13:59:10 2009
> +++ ./t/add_property.t  Sun Aug  9 13:48:56 2009
> @@ -91,3 +91,5 @@ eval { $build->installdirs('foo') };
>  ok $err = $@, 'Should catch exception for invalid "installdirs" value';
>  like $err, qr/ERROR: installdirs must be one of "core", "site", or "vendor"/,
>   'And it should suggest the proper values in the error message';
> +
> +$dist->chdir_original if $dist->did_chdir;
> --- ./t/help.t-pre      Tue Jul  7 13:59:10 2009
> +++ ./t/help.t  Sun Aug  9 14:26:14 2009
> @@ -22,7 +22,7 @@ $dist->regen;
>
>  my $restart = sub {
>   $dist->clean();
> -  chdir( $cwd );
> +  DistGen::chdir_all( $cwd );
>   File::Path::rmtree( $tmp );
>   # we're redefining the same package as we go, so...
>   delete($::{'MyModuleBuilder::'});
> @@ -274,7 +274,7 @@ is($mb->get_action_docs('batz'), undef,
>
>  # cleanup
>  $dist->clean();
> -chdir( $cwd );
> +DistGen::chdir_all($cwd);
>  File::Path::rmtree( $tmp );
>
>  # vim:ts=2:sw=2:et:sta
> --- ./t/PL_files.t-pre  Tue Jul  7 13:59:10 2009
> +++ ./t/PL_files.t      Sun Aug  9 13:48:20 2009
> @@ -82,5 +82,5 @@ END
>     my %cleanup = map { $_ => 1 } $mb->cleanup;
>     is($cleanup{foo}, undef, "generated special file not added to cleanup");
>
> -
> +    $dist->chdir_original if $dist->did_chdir;
>  }
> --- ./t/script_dist.t-pre       Tue Jul  7 13:59:10 2009
> +++ ./t/script_dist.t   Sun Aug  9 14:06:38 2009
> @@ -77,3 +77,4 @@ SKIP: {
>   my $yml = YAML::LoadFile('META.yml');
>   is_deeply($yml->{provides}, \%meta_provides);
>  }
> +$dist->chdir_original if $dist->did_chdir;
> --- ./t/tilde.t-pre     Tue Jul  7 13:59:10 2009
> +++ ./t/tilde.t Sun Aug  9 12:41:54 2009
> @@ -55,10 +55,6 @@ SKIP: {
>
>     is( run_sample( $p => '~/foo' )->$p(),  "$home/foo" );
>
> -    is( run_sample( $p => '~~'    )->$p(),  '~~' );
> -
> -    is( run_sample( $p => '~ foo' )->$p(),  '~ foo' );
> -
>     is( run_sample( $p => '~/ foo')->$p(),  "$home/ foo" );
>
>     is( run_sample( $p => '~/fo o')->$p(),  "$home/fo o" );
> @@ -91,6 +87,10 @@ SKIP: {
>
>     $mb->$p('~');
>     is( $mb->$p(),      '~', 'API does not expand tildes' );
> +
> +    skip "On OS/2 EMX all users are equal", 2 if $^O eq 'os2';
> +    is( run_sample( $p => '~~'    )->$p(),  '~~' );
> +    is( run_sample( $p => '~ foo' )->$p(),  '~ foo' );
>  }
>
>  # Again, with named users
> --- ./t/write_default_maniskip.t-pre    Tue Jul  7 13:59:10 2009
> +++ ./t/write_default_maniskip.t        Sun Aug  9 14:16:12 2009
> @@ -5,11 +5,14 @@ use warnings;
>
>  use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
>  use MBTest 'no_plan';
> +use DistGen;
> +use Cwd;
>
>  use_ok 'Module::Build';
>  ensure_blib 'Module::Build';
>
>  {
> +    my $cwd = Cwd::cwd;
>     chdir MBTest->tmpdir();
>
>     my $build = Module::Build->new(
> @@ -34,4 +37,6 @@ ensure_blib 'Module::Build';
>     like $have, qr/^\Q$head\E/, "default MANIFEST.SKIP used";
>     like $have, qr/^# Avoid Module::Build generated /ms, "Module::Build specific entries";
>     like $have, qr/Foo-Bar-/, "distribution tarball entry";
> +
> +    DistGen::chdir_all($cwd);
>  }
> --- ./t/lib/DistGen.pm-pre      Tue Jul  7 13:59:10 2009
> +++ ./t/lib/DistGen.pm  Sun Aug  9 13:59:16 2009
> @@ -62,6 +62,13 @@ sub undent {
>
>   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;
> +}
>  ########################################################################
>
>  sub new {
> @@ -388,7 +395,7 @@ sub clean {
>     }
>   }, ($^O eq 'VMS' ? './' : File::Spec->curdir) );
>
> -  chdir( $here );
> +  chdir_all( $here );
>  }
>
>  sub remove {
> @@ -478,7 +485,7 @@ sub chdir_original {
>
>   croak("never called chdir_in()") unless($self->{original_dir});
>   my $dir = $self->{original_dir};
> -  chdir($dir) or die "Can't chdir to '$dir': $!";
> +  chdir_all($dir) or die "Can't chdir to '$dir': $!";
>  }
>  ########################################################################
>
>
>