-#!./perl -Tw
+#!/usr/bin/perl -w
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib/');
+ }
+ else {
+ unshift @INC, 't/lib/';
+ }
}
+chdir 't';
BEGIN {
1 while unlink 'ecmdfile';
}
BEGIN {
- use Test::More tests => 21;
+ use Test::More tests => 24;
use File::Spec;
}
{
- use vars qw( *CORE::GLOBAL::exit );
-
# bad neighbor, but test_f() uses exit()
+ *CORE::GLOBAL::exit = ''; # quiet 'only once' warning.
*CORE::GLOBAL::exit = sub { return @_ };
use_ok( 'ExtUtils::Command' );
}
}
+
+ # % means 'match one character' on VMS. Everything else is ?
+ my $match_char = $^O eq 'VMS' ? '%' : '?';
+ ($ARGV[0] = $file) =~ s/.\z/$match_char/;
+
# this should find the file
- ($ARGV[0] = $file) =~ s/.\z/\?/;
ExtUtils::Command::expand_wildcards();
is( scalar @ARGV, 1, 'found one file' );
# concatenate this file with itself
# be extra careful the regex doesn't match itself
+ use TieOut;
my $out = tie *STDOUT, 'TieOut';
my $self = $0;
unless (-f $self) {
# to the beginning of the day in Win95.
# There's a small chance of a 1 second flutter here.
my $stamp = (stat($ARGV[0]))[9];
- ok( abs($now - $stamp) <= 1, 'checking modify time stamp' ) ||
- print "# mtime == $stamp, should be $now\n";
+ cmp_ok( abs($now - $stamp), '<=', 1, 'checking modify time stamp' ) ||
+ diag "mtime == $stamp, should be $now";
+
+ SKIP: {
+ if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' ||
+ $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin' ||
+ $^O eq 'MacOS') {
+ skip( "different file permission semantics on $^O", 3);
+ }
+
+ # change a file to execute-only
+ @ARGV = ( 0100, 'ecmdfile' );
+ ExtUtils::Command::chmod();
+
+ is( ((stat('ecmdfile'))[2] & 07777) & 0700,
+ 0100, 'change a file to execute-only' );
+
+ # change a file to read-only
+ @ARGV = ( 0400, 'ecmdfile' );
+ ExtUtils::Command::chmod();
+
+ is( ((stat('ecmdfile'))[2] & 07777) & 0700,
+ ($^O eq 'vos' ? 0500 : 0400), 'change a file to read-only' );
- # change a file to read-only
+ # change a file to write-only
+ @ARGV = ( 0200, 'ecmdfile' );
+ ExtUtils::Command::chmod();
+
+ is( ((stat('ecmdfile'))[2] & 07777) & 0700,
+ ($^O eq 'vos' ? 0700 : 0200), 'change a file to write-only' );
+ }
+
+ # change a file to read-write
@ARGV = ( 0600, 'ecmdfile' );
ExtUtils::Command::chmod();
- is( ((stat('ecmdfile'))[2] & 07777) & 0700, 0600, 'change a file to read-only' );
+ is( ((stat('ecmdfile'))[2] & 07777) & 0700,
+ ($^O eq 'vos' ? 0700 : 0600), 'change a file to read-write' );
# mkpath
@ARGV = ( File::Spec->join( 'ecmddir', 'temp2' ) );
1 while unlink 'ecmdfile';
File::Path::rmtree( 'ecmddir' );
}
-
-package TieOut;
-
-sub TIEHANDLE {
- bless( \(my $text), $_[0] );
-}
-
-sub PRINT {
- ${ $_[0] } .= join($/, @_);
-}