Front page | perl.perl5.porters |
Postings from May 2009
Remove duplication of test setup.
Thread Next
From:
Sean O'Rourke
Date:
May 29, 2009 18:17
Subject:
Remove duplication of test setup.
Message ID:
m23aanmltq.fsf@cs.ucsd.edu
diff --git a/ext/B/t/debug.t b/ext/B/t/debug.t
index b37565c..ea87c79 100755
--- a/ext/B/t/debug.t
+++ b/ext/B/t/debug.t
@@ -27,13 +27,12 @@ use Config;
use Test::More tests => 7;
use B;
use B::Debug;
+use vars '%Is';
my $a;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
my $path = join " ", map { qq["-I$_"] } @INC;
-my $redir = $Is_MacOS ? "" : "2>&1";
+my $redir = $Is{MacOS} ? "" : "2>&1";
$a = `$^X $path "-MO=Debug" -e 1 $redir`;
like($a, qr/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s);
diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t
index 27e9f9e..96090a9 100644
--- a/ext/B/t/deparse.t
+++ b/ext/B/t/deparse.t
@@ -21,6 +21,7 @@ BEGIN {
use warnings;
use strict;
+use vars '%Is';
BEGIN {
# BEGIN block is acutally a subroutine :-)
return unless $] > 5.009;
@@ -112,12 +113,9 @@ my $val = (eval $string)->() or diag $string;
is(ref($val), 'ARRAY');
is($val->[0], 'hello');
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-
my $path = join " ", map { qq["-I$_"] } @INC;
-$path .= " -MMac::err=unix" if $Is_MacOS;
-my $redir = $Is_MacOS ? "" : "2>&1";
+$path .= " -MMac::err=unix" if $Is{MacOS};
+my $redir = $Is{MacOS} ? "" : "2>&1";
$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`;
$a =~ s/-e syntax OK\n//g;
@@ -139,7 +137,7 @@ $b =~ s/(LINE:)/sub BEGIN {
'OSA'->bootstrap;
'XL'->bootstrap;
}
-$1/ if $Is_MacOS;
+$1/ if $Is{MacOS};
is($a, $b);
#Re: perlbug #35857, patch #24505
@@ -148,6 +146,7 @@ package B::Deparse::Wrapper;
use strict;
use warnings;
use warnings::register;
+use vars '%Is';
sub getcode {
my $deparser = B::Deparse->new();
return $deparser->coderef2text(shift);
@@ -343,10 +342,10 @@ our @ary;
@ary = split(' ', 'foo', 0);
####
# 35 (bug #40055)
-do { () };
+do { () };
####
# 36 (ibid.)
-do { my $x = 1; $x };
+do { my $x = 1; $x };
####
# 37 <20061012113037.GJ25805@c4.convolution.nl>
my $f = sub {
diff --git a/ext/B/t/showlex.t b/ext/B/t/showlex.t
index 3cb28da..b66a877 100755
--- a/ext/B/t/showlex.t
+++ b/ext/B/t/showlex.t
@@ -24,6 +24,7 @@ BEGIN {
$| = 1;
use warnings;
use strict;
+use vars '%Is';
use Config;
use B::Showlex ();
@@ -32,12 +33,10 @@ plan tests => 15;
my $verbose = @ARGV; # set if ANY ARGS
my $a;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
my $path = join " ", map { qq["-I$_"] } @INC;
-$path = '"-I../lib" "-Iperl_root:[lib]"' if $Is_VMS; # gets too long otherwise
-my $redir = $Is_MacOS ? "" : "2>&1";
+$path = '"-I../lib" "-Iperl_root:[lib]"' if $Is{VMS}; # gets too long otherwise
+my $redir = $Is{MacOS} ? "" : "2>&1";
my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
if ($is_thread) {
diff --git a/ext/Data-Dumper/t/dumper.t b/ext/Data-Dumper/t/dumper.t
index 6b99ca1..01f4882 100755
--- a/ext/Data-Dumper/t/dumper.t
+++ b/ext/Data-Dumper/t/dumper.t
@@ -20,7 +20,6 @@ local $Data::Dumper::Sortkeys = 1;
use Data::Dumper;
use Config;
-my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
$Data::Dumper::Pad = "#";
my $TMAX;
@@ -35,7 +34,7 @@ sub TEST {
++$TNUM;
$t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
if ($WANT =~ /deadbeef/);
- if ($Is_ebcdic) {
+ if ($Is{ebcdic}) {
# these data need massaging with non ascii character sets
# because of hashing order differences
$WANT = join("\n",sort(split(/\n/,$WANT)));
@@ -48,7 +47,7 @@ sub TEST {
: "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
++$TNUM;
- if ($Is_ebcdic) { # EBCDIC.
+ if ($Is{ebcdic}) { # EBCDIC.
if ($TNUM == 311 || $TNUM == 314) {
eval $string;
} else {
@@ -63,7 +62,7 @@ sub TEST {
++$TNUM;
$t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
if ($WANT =~ /deadbeef/);
- if ($Is_ebcdic) {
+ if ($Is{ebcdic}) {
# here too there are hashing order differences
$WANT = join("\n",sort(split(/\n/,$WANT)));
$WANT =~ s/\,$//mg;
@@ -498,7 +497,7 @@ EOT
$dogs[2] = \%kennel;
$mutts = \%kennel;
$mutts = $mutts; # avoid warning
-
+
############# 85
##
$WANT = <<'EOT';
@@ -526,7 +525,7 @@ EOT
$d->Dumpxs;
);
}
-
+
############# 91
##
$WANT = <<'EOT';
@@ -537,7 +536,7 @@ EOT
TEST q($d->Dump);
TEST q($d->Dumpxs) if $XS;
-
+
############# 97
##
$WANT = <<'EOT';
@@ -553,7 +552,7 @@ EOT
#%mutts = %kennels;
EOT
-
+
TEST q($d->Reset; $d->Dump);
if ($XS) {
TEST q($d->Reset; $d->Dumpxs);
@@ -586,7 +585,7 @@ EOT
$d->Dumpxs;
);
}
-
+
############# 109
##
TEST q($d->Reset->Dump);
@@ -618,7 +617,7 @@ EOT
if ($XS) {
TEST q($d->Reset->Dumpxs);
}
-
+
}
{
@@ -918,7 +917,7 @@ TEST q(Data::Dumper->new([$c])->Dumpxs;)
local $Data::Dumper::Sortkeys = \&sort205;
sub sort205 {
my $hash = shift;
- return [
+ return [
$hash eq $c ? (sort { $a <=> $b } keys %$hash)
: (reverse sort keys %$hash)
];
@@ -1310,7 +1309,7 @@ EOT
#XXX}
{
- if ($Is_ebcdic) {
+ if ($Is{ebcdic}) {
$b = "Bad. XS didn't escape dollar sign";
############# 322
$WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
diff --git a/ext/Digest-MD5/t/md5-aaa.t b/ext/Digest-MD5/t/md5-aaa.t
index 1ccd59b..0d02b30 100644
--- a/ext/Digest-MD5/t/md5-aaa.t
+++ b/ext/Digest-MD5/t/md5-aaa.t
@@ -6,15 +6,14 @@ BEGIN {
}
use strict;
+use vars '%Is';
print "1..256\n";
use Digest::MD5 qw(md5_hex);
-my $Is_EBCDIC = ord('A') == 193;
-
my $testno = 0;
while (<DATA>) {
- if (!$Is_EBCDIC) {
+ if (!$Is{EBCDIC}) {
next if /^EBCDIC/;
}
else {
diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t
index 9366532..b030486 100644
--- a/ext/POSIX/t/posix.t
+++ b/ext/POSIX/t/posix.t
@@ -19,20 +19,11 @@ use strict 'subs';
$| = 1;
-$Is_W32 = $^O eq 'MSWin32';
-$Is_Dos = $^O eq 'dos';
-$Is_MPE = $^O eq 'mpeix';
-$Is_MacOS = $^O eq 'MacOS';
-$Is_VMS = $^O eq 'VMS';
-$Is_OS2 = $^O eq 'os2';
-$Is_UWin = $^O eq 'uwin';
-$Is_OS390 = $^O eq 'os390';
-
my $vms_unix_rpt = 0;
my $vms_efs = 0;
my $unix_mode = 1;
-if ($Is_VMS) {
+if ($Is{VMS}) {
$unix_mode = 0;
if (eval 'require VMS::Feature') {
$vms_unix_rpt = VMS::Feature::current("filename_unix_report");
@@ -66,7 +57,7 @@ write(1,"ok 4\nnot ok 4\n", 5);
next_test();
SKIP: {
- skip("no pipe() support on DOS", 2) if $Is_Dos;
+ skip("no pipe() support on DOS", 2) if $Is{Dos};
@fds = POSIX::pipe();
ok( $fds[0] > $testfd, 'POSIX::pipe' );
@@ -81,7 +72,7 @@ SKIP: {
}
SKIP: {
- skip("no sigaction support on win32/dos", 6) if $Is_W32 || $Is_Dos;
+ skip("no sigaction support on win32/dos", 6) if $Is{W32} || $Is{Dos};
my $sigset = new POSIX::SigSet 1, 3;
$sigset->delset(1);
@@ -89,7 +80,7 @@ SKIP: {
ok( $sigset->ismember(3), 'POSIX::SigSet->ismember' );
SKIP: {
- skip("no kill() support on Mac OS", 4) if $Is_MacOS;
+ skip("no kill() support on Mac OS", 4) if $Is{MacOS};
my $sigint_called = 0;
@@ -105,8 +96,8 @@ SKIP: {
# For others (darwin & freebsd), let the test fail without crashing.
my $todo = $^O eq 'netbsd' && $Config{osvers}=~/^1\.6/;
my $why_todo = "# TODO $^O $Config{osvers} seems to lose blocked signals";
- if (!$todo) {
- kill 'HUP', $$;
+ if (!$todo) {
+ kill 'HUP', $$;
} else {
print "not ok 9 - sigaction SIGHUP ",$why_todo,"\n";
print "not ok 10 - sig mask delayed SIGINT ",$why_todo,"\n";
@@ -120,7 +111,7 @@ SKIP: {
$todo ? $why_todo : '';
print "ok 12 - signal masks successful\n";
-
+
sub SigHUP {
print "ok 9 - sigaction SIGHUP\n";
kill 'INT', $$;
@@ -139,7 +130,7 @@ SKIP: {
}
SKIP: {
- skip("_POSIX_OPEN_MAX is inaccurate on MPE", 1) if $Is_MPE;
+ skip("_POSIX_OPEN_MAX is inaccurate on MPE", 1) if $Is{MPE};
skip("_POSIX_OPEN_MAX undefined ($fds[1])", 1) unless &_POSIX_OPEN_MAX;
ok( &_POSIX_OPEN_MAX >= 16, "The minimum allowed values according to susv2" );
@@ -147,9 +138,9 @@ SKIP: {
}
my $pat;
-if ($Is_MacOS) {
+if ($Is{MacOS}) {
$pat = qr/:t:$/;
-}
+}
elsif ( $unix_mode ) {
$pat = qr#[\\/]t$#i;
}
@@ -160,7 +151,7 @@ like( getcwd(), qr/$pat/, 'getcwd' );
# Check string conversion functions.
-SKIP: {
+SKIP: {
skip("strtod() not present", 1) unless $Config{d_strtod};
$lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
@@ -194,7 +185,7 @@ ok( &POSIX::acos(1.0) == 0.0, 'dynamic loading' );
# This can coredump if struct tm has a timezone field and we
# didn't detect it. If this fails, try adding
# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
-# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl
+# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl
print POSIX::strftime("ok 21 # %H:%M, on %m/%d/%y\n", localtime());
next_test();
@@ -210,7 +201,7 @@ $lc = &POSIX::setlocale(&POSIX::LC_TIME, 'C') if $Config{d_setlocale};
try_strftime("Wed Feb 28 00:00:00 1996 059", 0,0,0, 28,1,96);
SKIP: {
skip("VC++ 8 and Vista's CRTs regard 60 seconds as an invalid parameter", 1)
- if ($Is_W32 and (($Config{cc} eq 'cl' and
+ if ($Is{W32} and (($Config{cc} eq 'cl' and
$Config{ccversion} =~ /^(\d+)/ and $1 >= 14) or
(Win32::GetOSVersion())[1] >= 6));
@@ -228,7 +219,7 @@ try_strftime("Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
{
for my $test (0, 1) {
$! = 0;
- # POSIX::errno is autoloaded.
+ # POSIX::errno is autoloaded.
# Autoloading requires many system calls.
# errno() looks at $! to generate its result.
# Autoloading should not munge the value.
@@ -241,7 +232,7 @@ try_strftime("Fri Mar 31 00:00:00 2000 091", 0,0,0, 31,2,100);
}
SKIP: {
- skip("no kill() support on Mac OS", 1) if $Is_MacOS;
+ skip("no kill() support on Mac OS", 1) if $Is{MacOS};
is (eval "kill 0", 0, "check we have CORE::kill")
or print "\$\@ is " . _qq($@) . "\n";
}
@@ -298,7 +289,7 @@ ok( POSIX::isprint([]), 'isprint []' );
eval { use strict; POSIX->import("S_ISBLK"); my $x = S_ISBLK };
unlike( $@, qr/Can't use string .* as a symbol ref/, "Can import autoloaded constants" );
-
+
# Check that output is not flushed by _exit. This test should be last
# in the file, and is not counted in the total number of tests.
if ($^O eq 'vos') {
@@ -306,8 +297,8 @@ if ($^O eq 'vos') {
} else {
$| = 0;
# The following line assumes buffered output, which may be not true:
- print '@#!*$@(!@#$' unless ($Is_MacOS || $Is_OS2 || $Is_UWin || $Is_OS390 ||
- $Is_VMS ||
+ print '@#!*$@(!@#$' unless ($Is{MacOS} || $Is{OS2} || $Is{UWin} || $Is{OS390} ||
+ $Is{VMS} ||
(defined $ENV{PERLIO} &&
$ENV{PERLIO} eq 'unix' &&
$Config::Config{useperlio}));
diff --git a/lib/AnyDBM_File.t b/lib/AnyDBM_File.t
index cb9eee9..1660fa5 100755
--- a/lib/AnyDBM_File.t
+++ b/lib/AnyDBM_File.t
@@ -12,11 +12,6 @@ require AnyDBM_File;
use Fcntl;
-$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' ||
- $^O eq 'NetWare' || $^O eq 'dos' ||
- $^O eq 'os2' || $^O eq 'mint' ||
- $^O eq 'cygwin');
-
unlink <Op_dbmx*>;
umask(0);
@@ -31,7 +26,7 @@ if (! -e $Dfile) {
SKIP:
{
skip( "different file permission semantics",1)
- if ($Is_Dosish || $^O eq 'MacOS') ;
+ if ($Is{Dosish} || $^O eq 'MacOS') ;
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat($Dfile);
ok(($mode & 0777) == ($^O eq 'vos' ? 0750 : 0640) , "File permissions");
@@ -134,7 +129,7 @@ if ($AnyDBM_File::ISA[0] eq 'DB_File' && ($DB_File::db_ver >= 2.004010 && $DB_Fi
$compact = "$major.$minor.$patch" ;
#
# anydbm.t test 12 will fail when AnyDBM_File uses the combination of
- # DB_File and Berkeley DB 2.4.10 (or greater).
+ # DB_File and Berkeley DB 2.4.10 (or greater).
# You are using DB_File $DB_File::VERSION and Berkeley DB $compact
#
# Berkeley DB 2 from version 2.4.10 onwards does not allow null keys.
@@ -153,5 +148,5 @@ untie %h;
if ($^O eq 'VMS') {
unlink 'Op_dbmx.sdbm_dir', $Dfile;
} else {
- unlink 'Op_dbmx.dir', $Dfile;
+ unlink 'Op_dbmx.dir', $Dfile;
}
diff --git a/lib/AutoLoader/t/02AutoSplit.t b/lib/AutoLoader/t/02AutoSplit.t
index 150301a..d5fe41d 100644
--- a/lib/AutoLoader/t/02AutoSplit.t
+++ b/lib/AutoLoader/t/02AutoSplit.t
@@ -22,16 +22,16 @@ my $runperl = "$^X $lib";
use warnings;
use strict;
+use vars '%Is';
use Test::More tests => 58;
use File::Spec;
use File::Find;
-my $Is_VMS = $^O eq 'VMS';
my $Is_VMS_mode = 0;
my $Is_VMS_lc = 0;
-if ($Is_VMS) {
- require VMS::Filespec if $Is_VMS;
+if ($Is{VMS}) {
+ require VMS::Filespec if $Is{VMS};
my $vms_unix_rpt;
my $vms_case;
diff --git a/lib/Carp.t b/lib/Carp.t
index c24760b..7e0a60e 100644
--- a/lib/Carp.t
+++ b/lib/Carp.t
@@ -4,8 +4,6 @@ BEGIN {
require './test.pl';
}
-my $Is_VMS = $^O eq 'VMS';
-
use Carp qw(carp cluck croak confess);
plan tests => 37;
@@ -240,15 +238,15 @@ sub w { cluck @_ }
}
{
- local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS;
+ local $TODO = "VMS exit status semantics don't work this way" if $Is{VMS};
# Check that croak() and confess() don't clobber $!
- runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})',
+ runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; croak(q{Dead})',
stderr => 1);
is($?>>8, 42, 'croak() doesn\'t clobber $!');
- runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})',
+ runperl(prog => 'use Carp; $@=q{Phooey}; $!=42; confess(q{Dead})',
stderr => 1);
is($?>>8, 42, 'confess() doesn\'t clobber $!');
diff --git a/lib/ExtUtils/t/INSTALL_BASE.t b/lib/ExtUtils/t/INSTALL_BASE.t
index 95c62cc..ce39f9f 100644
--- a/lib/ExtUtils/t/INSTALL_BASE.t
+++ b/lib/ExtUtils/t/INSTALL_BASE.t
@@ -20,8 +20,6 @@ use Test::More tests => 20;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;
-my $Is_VMS = $^O eq 'VMS';
-
my $perl = which_perl();
chdir 't';
@@ -42,7 +40,7 @@ cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
diag(@mpl_out);
my $makefile = makefile_name();
-ok( grep(/^Writing $makefile for Big::Dummy/,
+ok( grep(/^Writing $makefile for Big::Dummy/,
@mpl_out) == 1,
'Makefile.PL output looks right');
@@ -54,7 +52,7 @@ like( $install_out, qr/^Installing /m );
ok( -r '../dummy-install', ' install dir created' );
-my @installed_files =
+my @installed_files =
('../dummy-install/lib/perl5/Big/Dummy.pm',
'../dummy-install/lib/perl5/Big/Liar.pm',
'../dummy-install/bin/program',
diff --git a/lib/ExtUtils/t/INST_PREFIX.t b/lib/ExtUtils/t/INST_PREFIX.t
index 57e7eb2..c36eb79 100644
--- a/lib/ExtUtils/t/INST_PREFIX.t
+++ b/lib/ExtUtils/t/INST_PREFIX.t
@@ -16,6 +16,7 @@ BEGIN {
}
use strict;
+use vars '%Is';
use Test::More tests => 52;
use MakeMaker::Test::Utils;
use MakeMaker::Test::Setup::BFD;
@@ -24,8 +25,6 @@ use File::Spec;
use TieOut;
use ExtUtils::MakeMaker::Config;
-my $Is_VMS = $^O eq 'VMS';
-
chdir 't';
perl_lib;
@@ -122,8 +121,8 @@ my %Install_Vars = (
while( my($type, $vars) = each %Install_Vars) {
SKIP: {
- skip "VMS must expand macros in INSTALL* vars", scalar @$vars
- if $Is_VMS;
+ skip "VMS must expand macros in INSTALL* vars", scalar @$vars
+ if $Is{VMS};
skip '$Config{usevendorprefix} not set', scalar @$vars
if $type eq 'VENDOR' and !$Config{usevendorprefix};
@@ -136,10 +135,10 @@ while( my($type, $vars) = each %Install_Vars) {
if $mm->{uc $installvar} =~ /^\$\(INSTALL.*\)$/;
# support for man page skipping
- $prefix = 'none' if $type eq 'PERL' &&
- $var =~ /man/ &&
+ $prefix = 'none' if $type eq 'PERL' &&
+ $var =~ /man/ &&
!$Config{$installvar};
- like( $mm->{uc $installvar}, qr/^\Q$prefix\E/,
+ like( $mm->{uc $installvar}, qr/^\Q$prefix\E/,
"$prefix + $var" );
}
}
@@ -187,9 +186,9 @@ while( my($type, $vars) = each %Install_Vars) {
INSTALLMAN3DIR=> 'foo/bar/baz',
);
- is( $mm->{INSTALLVENDORMAN1DIR}, File::Spec->catdir('foo','bar'),
+ is( $mm->{INSTALLVENDORMAN1DIR}, File::Spec->catdir('foo','bar'),
'installvendorman1dir (in %Config) not modified' );
- isnt( $mm->{INSTALLVENDORMAN3DIR}, '',
+ isnt( $mm->{INSTALLVENDORMAN3DIR}, '',
'installvendorman3dir (not in %Config) set' );
}
@@ -216,7 +215,7 @@ while( my($type, $vars) = each %Install_Vars) {
is( $mm->{INSTALLMAN1DIR}, File::Spec->catdir('foo', 'bar') );
is( $mm->{INSTALLMAN3DIR}, File::Spec->catdir('foo', 'baz') );
SKIP: {
- skip "VMS must expand macros in INSTALL* vars", 4 if $Is_VMS;
+ skip "VMS must expand macros in INSTALL* vars", 4 if $Is{VMS};
is( $mm->{INSTALLSITEMAN1DIR}, '$(INSTALLMAN1DIR)' );
is( $mm->{INSTALLSITEMAN3DIR}, '$(INSTALLMAN3DIR)' );
@@ -226,7 +225,7 @@ while( my($type, $vars) = each %Install_Vars) {
}
-# Check that when usevendoprefix and installvendorman*dir aren't set in
+# Check that when usevendoprefix and installvendorman*dir aren't set in
# Config it leaves them unset.
{
_set_config(installman1dir => File::Spec->catdir('foo', 'bar') );
@@ -249,7 +248,7 @@ while( my($type, $vars) = each %Install_Vars) {
is( $mm->{INSTALLMAN1DIR}, File::Spec->catdir('foo', 'bar') );
is( $mm->{INSTALLMAN3DIR}, File::Spec->catdir('foo', 'baz') );
SKIP: {
- skip "VMS must expand macros in INSTALL* vars", 2 if $Is_VMS;
+ skip "VMS must expand macros in INSTALL* vars", 2 if $Is{VMS};
is( $mm->{INSTALLSITEMAN1DIR}, '$(INSTALLMAN1DIR)' );
is( $mm->{INSTALLSITEMAN3DIR}, '$(INSTALLMAN3DIR)' );
}
@@ -265,6 +264,6 @@ sub _set_config {
# Because VMS's config has traditionally been underpopulated, it will
# fall back to the install-less versions in desperation.
- $Config{$k_no_install} = $v if $Is_VMS;
+ $Config{$k_no_install} = $v if $Is{VMS};
return;
}
diff --git a/lib/ExtUtils/t/Installed.t b/lib/ExtUtils/t/Installed.t
index f820ef4..2c584c8 100644
--- a/lib/ExtUtils/t/Installed.t
+++ b/lib/ExtUtils/t/Installed.t
@@ -11,9 +11,8 @@ BEGIN {
}
chdir 't';
-my $Is_VMS = $^O eq 'VMS';
-
use strict;
+use vars '%Is';
use Config;
use Cwd;
@@ -59,7 +58,7 @@ my $prefix = $Config{prefix} || $Config{prefixexp};
# You can concatenate /foo but not foo:, which defaults in the current
# directory
-$prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;
+$prefix = VMS::Filespec::unixify($prefix) if $Is{VMS};
# ActivePerl 5.6.1/631 has $Config{prefixexp} as 'p:' for some reason
$prefix = $Config{prefix} if $prefix eq 'p:' && $^O eq 'MSWin32';
@@ -185,12 +184,12 @@ my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
);
isa_ok( $realei, 'ExtUtils::Installed' );
isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
- ok( exists $realei->{FakeMod},
+ ok( exists $realei->{FakeMod},
'new() with extra_libs should find modules with .packlists');
-
+
#{ use Data::Dumper; local $realei->{':private:'}{Config};
# warn Dumper($realei); }
-
+
isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
is( $realei->{FakeMod}{version}, '1.1.1',
'... should find version in modules' );
diff --git a/lib/ExtUtils/t/Manifest.t b/lib/ExtUtils/t/Manifest.t
index 3aca61d..7e3bd13 100644
--- a/lib/ExtUtils/t/Manifest.t
+++ b/lib/ExtUtils/t/Manifest.t
@@ -12,6 +12,7 @@ BEGIN {
chdir 't';
use strict;
+use vars '%Is';
use Test::More tests => 94;
use Cwd;
@@ -21,15 +22,14 @@ use File::Path;
use File::Find;
use Config;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_VMS_noefs = $Is_VMS;
-if ($Is_VMS) {
+my $Is_VMS_noefs = $Is{VMS};
+if ($Is{VMS}) {
my $vms_efs = 0;
if (eval 'require VMS::Feature') {
$vms_efs = VMS::Feature::current("efs_charset");
} else {
my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
- $vms_efs = $efs_charset =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
}
$Is_VMS_noefs = 0 if $vms_efs;
}
@@ -70,10 +70,10 @@ sub remove_dir {
}
# use module, import functions
-BEGIN {
- use_ok( 'ExtUtils::Manifest',
- qw( mkmanifest manicheck filecheck fullcheck
- maniread manicopy skipcheck maniadd maniskip) );
+BEGIN {
+ use_ok( 'ExtUtils::Manifest',
+ qw( mkmanifest manicheck filecheck fullcheck
+ maniread manicopy skipcheck maniadd maniskip) );
}
my $cwd = Cwd::getcwd();
@@ -94,7 +94,7 @@ chmod( 0744, 'foo') if $Config{'chmod'};
# there shouldn't be a MANIFEST there
my ($res, $warn) = catch_warning( \&mkmanifest );
# Canonize the order.
-$warn = join("", map { "$_|" }
+$warn = join("", map { "$_|" }
sort { lc($a) cmp lc($b) } split /\r?\n/, $warn);
is( $warn, "Added to MANIFEST: foo|Added to MANIFEST: MANIFEST|",
"mkmanifest() displayed its additions" );
@@ -144,14 +144,14 @@ is( join( ' ', @skipped ), 'MANIFEST.SKIP', 'listed skipped files' );
# add a subdirectory and a file there that should be found
ok( mkdir( 'moretest', 0777 ), 'created moretest directory' );
add_file( File::Spec->catfile('moretest', 'quux'), 'quux' );
-ok( exists( ExtUtils::Manifest::manifind()->{'moretest/quux'} ),
+ok( exists( ExtUtils::Manifest::manifind()->{'moretest/quux'} ),
"manifind found moretest/quux" );
# only MANIFEST and foo are in the manifest
$_ = 'foo';
my $files = maniread();
is( keys %$files, 2, 'two files found' );
-is( join(' ', sort { lc($a) cmp lc($b) } keys %$files), 'foo MANIFEST',
+is( join(' ', sort { lc($a) cmp lc($b) } keys %$files), 'foo MANIFEST',
'both files found' );
is( $_, 'foo', q{maniread() doesn't clobber $_} );
@@ -161,7 +161,7 @@ ok( mkdir( 'copy', 0777 ), 'made copy directory' );
manicopy( $files, 'copy', 'cp' );
my @copies = ();
find( sub { push @copies, $_ if -f }, 'copy' );
-@copies = map { s/\.$//; $_ } @copies if $Is_VMS; # VMS likes to put dots on
+@copies = map { s/\.$//; $_ } @copies if $Is{VMS}; # VMS likes to put dots on
# the end of files.
# Have to compare insensitively for non-case preserving VMS
is_deeply( [sort map { lc } @copies], [sort map { lc } keys %$files] );
@@ -178,7 +178,7 @@ rmtree('copy');
# poison the manifest, and add a comment that should be reported
add_file( 'MANIFEST', 'none #none' );
-is( ExtUtils::Manifest::maniread()->{none}, '#none',
+is( ExtUtils::Manifest::maniread()->{none}, '#none',
'maniread found comment' );
ok( mkdir( 'copy', 0777 ), 'made copy directory' );
@@ -196,7 +196,7 @@ like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' );
# tell ExtUtils::Manifest to use a different file
{
- local $ExtUtils::Manifest::MANIFEST = 'albatross';
+ local $ExtUtils::Manifest::MANIFEST = 'albatross';
($res, $warn) = catch_warning( \&mkmanifest );
like( $warn, qr/Added to albatross: /, 'using a new manifest file' );
@@ -399,7 +399,7 @@ SKIP: {
eval {
maniadd({ 'grrrwoof' => 'yippie' });
};
- like( $@, qr/^\Qmaniadd() could not open MANIFEST:\E/,
+ like( $@, qr/^\Qmaniadd() could not open MANIFEST:\E/,
"maniadd() dies if it can't open the MANIFEST" );
chmod( 0600, 'MANIFEST' );
diff --git a/lib/ExtUtils/t/basic.t b/lib/ExtUtils/t/basic.t
index a0dc157..973b4bb 100644
--- a/lib/ExtUtils/t/basic.t
+++ b/lib/ExtUtils/t/basic.t
@@ -14,6 +14,7 @@ BEGIN {
}
use strict;
+use vars '%Is';
use Config;
use ExtUtils::MakeMaker;
@@ -29,10 +30,9 @@ use File::Path;
delete @ENV{qw(PREFIX LIB MAKEFLAGS)};
my $perl = which_perl();
-my $Is_VMS = $^O eq 'VMS';
# GNV logical interferes with testing
-$ENV{'bin'} = '[.bin]' if $Is_VMS;
+$ENV{'bin'} = '[.bin]' if $Is{VMS};
chdir 't';
@@ -58,7 +58,7 @@ cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
diag(@mpl_out);
my $makefile = makefile_name();
-ok( grep(/^Writing $makefile for Big::Dummy/,
+ok( grep(/^Writing $makefile for Big::Dummy/,
@mpl_out) == 1,
'Makefile.PL output looks right');
@@ -93,12 +93,12 @@ ok( open(PPD, 'Big-Dummy.ppd'), ' .ppd file generated' );
my $ppd_html;
{ local $/; $ppd_html = <PPD> }
close PPD;
-like( $ppd_html, qr{^<SOFTPKG NAME="Big-Dummy" VERSION="0,01,0,0">}m,
+like( $ppd_html, qr{^<SOFTPKG NAME="Big-Dummy" VERSION="0,01,0,0">}m,
' <SOFTPKG>' );
like( $ppd_html, qr{^\s*<TITLE>Big-Dummy</TITLE>}m, ' <TITLE>' );
-like( $ppd_html, qr{^\s*<ABSTRACT>Try "our" hot dog's</ABSTRACT>}m,
+like( $ppd_html, qr{^\s*<ABSTRACT>Try "our" hot dog's</ABSTRACT>}m,
' <ABSTRACT>');
-like( $ppd_html,
+like( $ppd_html,
qr{^\s*<AUTHOR>Michael G Schwern <schwern\@pobox.com></AUTHOR>}m,
' <AUTHOR>' );
like( $ppd_html, qr{^\s*<IMPLEMENTATION>}m, ' <IMPLEMENTATION>');
@@ -118,7 +118,7 @@ END { unlink 'Big-Dummy.ppd' }
my $test_out = run("$make test");
like( $test_out, qr/All tests successful/, 'make test' );
-is( $?, 0, ' exited normally' ) ||
+is( $?, 0, ' exited normally' ) ||
diag $test_out;
# Test 'make test TEST_VERBOSE=1'
@@ -136,14 +136,14 @@ like( $install_out, qr/^Installing /m );
ok( -r '../dummy-install', ' install dir created' );
my %files = ();
-find( sub {
+find( sub {
# do it case-insensitive for non-case preserving OSs
my $file = lc $_;
# VMS likes to put dots on the end of things that don't have them.
- $file =~ s/\.$// if $Is_VMS;
+ $file =~ s/\.$// if $Is{VMS};
- $files{$file} = $File::Find::name;
+ $files{$file} = $File::Find::name;
}, '../dummy-install' );
ok( $files{'dummy.pm'}, ' Dummy.pm installed' );
ok( $files{'liar.pm'}, ' Liar.pm installed' );
@@ -153,7 +153,7 @@ ok( $files{'perllocal.pod'},' perllocal.pod created' );
SKIP: {
- skip 'VMS install targets do not preserve $(PREFIX)', 9 if $Is_VMS;
+ skip 'VMS install targets do not preserve $(PREFIX)', 9 if $Is{VMS};
$install_out = run("$make install PREFIX=elsewhere");
is( $?, 0, 'install with PREFIX override' ) || diag $install_out;
@@ -172,17 +172,17 @@ SKIP: {
SKIP: {
- skip 'VMS install targets do not preserve $(DESTDIR)', 11 if $Is_VMS;
+ skip 'VMS install targets do not preserve $(DESTDIR)', 11 if $Is{VMS};
$install_out = run("$make install PREFIX= DESTDIR=other");
- is( $?, 0, 'install with DESTDIR' ) ||
+ is( $?, 0, 'install with DESTDIR' ) ||
diag $install_out;
like( $install_out, qr/^Installing /m );
ok( -d 'other', ' destdir created' );
%files = ();
my $perllocal;
- find( sub {
+ find( sub {
$files{$_} = $File::Find::name;
}, 'other' );
ok( $files{'Dummy.pm'}, ' Dummy.pm installed' );
@@ -191,7 +191,7 @@ SKIP: {
ok( $files{'.packlist'}, ' packlist created' );
ok( $files{'perllocal.pod'},' perllocal.pod created' );
- ok( open(PERLLOCAL, $files{'perllocal.pod'} ) ) ||
+ ok( open(PERLLOCAL, $files{'perllocal.pod'} ) ) ||
diag("Can't open $files{'perllocal.pod'}: $!");
{ local $/;
unlike(<PERLLOCAL>, qr/other/, 'DESTDIR should not appear in perllocal');
@@ -199,7 +199,7 @@ SKIP: {
close PERLLOCAL;
# TODO not available in the min version of Test::Harness we require
-# ok( open(PACKLIST, $files{'.packlist'} ) ) ||
+# ok( open(PACKLIST, $files{'.packlist'} ) ) ||
# diag("Can't open $files{'.packlist'}: $!");
# { local $/;
# local $TODO = 'DESTDIR still in .packlist';
@@ -212,10 +212,10 @@ SKIP: {
SKIP: {
- skip 'VMS install targets do not preserve $(PREFIX)', 10 if $Is_VMS;
+ skip 'VMS install targets do not preserve $(PREFIX)', 10 if $Is{VMS};
$install_out = run("$make install PREFIX=elsewhere DESTDIR=other/");
- is( $?, 0, 'install with PREFIX override and DESTDIR' ) ||
+ is( $?, 0, 'install with PREFIX override and DESTDIR' ) ||
diag $install_out;
like( $install_out, qr/^Installing /m );
@@ -239,7 +239,7 @@ is( $?, 0, 'disttest' ) || diag($dist_test_out);
use ExtUtils::Manifest qw(maniread);
my $distdir = 'Big-Dummy-0.01';
-$distdir =~ s/\./_/g if $Is_VMS;
+$distdir =~ s/\./_/g if $Is{VMS};
my $meta_yml = "$distdir/META.yml";
ok( !-f 'META.yml', 'META.yml not written to source dir' );
@@ -307,7 +307,7 @@ ok( !-f $meta_yml, 'META.yml generation suppressed by NO_META' );
cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out);
ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1,
- 'init_dirscan skipped distdir') ||
+ 'init_dirscan skipped distdir') ||
diag(@mpl_out);
# I know we'll get ignored errors from make here, that's ok.
diff --git a/lib/ExtUtils/t/cd.t b/lib/ExtUtils/t/cd.t
index dfd3ce4..167881a 100644
--- a/lib/ExtUtils/t/cd.t
+++ b/lib/ExtUtils/t/cd.t
@@ -11,9 +11,8 @@ BEGIN {
}
chdir 't';
-my $Is_VMS = $^O eq 'VMS';
-
use File::Spec;
+use vars '%Is';
use Test::More tests => 4;
@@ -32,14 +31,14 @@ my @cd_args = ($dir, "command1", "command2");
my @dirs = (File::Spec->updir) x 2;
my $expected_updir = File::Spec->catdir(@dirs);
-
+
::is $mm->cd(@cd_args),
qq{cd $dir
command1
command2
cd $expected_updir};
}
-
+
{
local *make = sub { "dmake" };
@@ -56,8 +55,8 @@ qq{cd $dir && command1
}
SKIP: {
- skip("VMS' cd requires vmspath which is only on VMS", 1) unless $Is_VMS;
-
+ skip("VMS' cd requires vmspath which is only on VMS", 1) unless $Is{VMS};
+
use ExtUtils::MM_VMS;
is +ExtUtils::MM_VMS->cd(@cd_args),
q{startdir = F$Environment("Default")
diff --git a/lib/ExtUtils/t/min_perl_version.t b/lib/ExtUtils/t/min_perl_version.t
index 7e44570..099fae1 100644
--- a/lib/ExtUtils/t/min_perl_version.t
+++ b/lib/ExtUtils/t/min_perl_version.t
@@ -14,6 +14,7 @@ BEGIN {
}
use strict;
+use vars '%Is';
use Test::More tests => 33;
use TieOut;
@@ -184,7 +185,7 @@ END
# ----- META.yml output -----
{
my $distdir = 'Min-PerlVers-0.05';
- $distdir =~ s{\.}{_}g if $Is_VMS;
+ $distdir =~ s{\.}{_}g if $Is{VMS};
my $meta_yml = "$distdir/META.yml";
my @make_out = run(qq{$make metafile});
diff --git a/lib/ExtUtils/t/prefixify.t b/lib/ExtUtils/t/prefixify.t
index b5bf139..b660477 100644
--- a/lib/ExtUtils/t/prefixify.t
+++ b/lib/ExtUtils/t/prefixify.t
@@ -11,6 +11,7 @@ BEGIN {
}
use strict;
+use vars '%Is';
use Test::More;
if( $^O eq 'VMS' ) {
@@ -23,8 +24,6 @@ use ExtUtils::MakeMaker::Config;
use File::Spec;
use ExtUtils::MM;
-my $Is_Dosish = $^O =~ /^(dos|MSWin32)$/;
-
my $mm = bless {}, 'MM';
my $default = File::Spec->catdir(qw(this that));
@@ -39,7 +38,7 @@ is( $mm->{INSTALLBIN}, File::Spec->catdir('something', $default),
'prefixify w/defaults and PREFIX');
SKIP: {
- skip "Test for DOSish prefixification", 1 unless $Is_Dosish;
+ skip "Test for DOSish prefixification", 1 unless $Is{Dosish};
$Config{wibble} = 'C:\opt\perl\wibble';
$mm->prefixify('wibble', 'C:\opt\perl', 'C:\yarrow');
diff --git a/lib/ExtUtils/t/prereq_print.t b/lib/ExtUtils/t/prereq_print.t
index 1dc0702..1df653a 100644
--- a/lib/ExtUtils/t/prereq_print.t
+++ b/lib/ExtUtils/t/prereq_print.t
@@ -31,7 +31,6 @@ delete @ENV{qw(PREFIX LIB MAKEFLAGS)};
my $Perl = which_perl();
my $Makefile = makefile_name();
-my $Is_VMS = $^O eq 'VMS';
chdir 't';
perl_lib;
@@ -64,7 +63,7 @@ is( $?, 0, ' exited normally' );
$prereq_out = run(qq{$Perl Makefile.PL "PRINT_PREREQ=1"});
ok( !-r $Makefile, "PRINT_PREREQ produces no $Makefile" );
is( $?, 0, ' exited normally' );
-::like( $prereq_out, qr/^perl\(strict\) \s* >= \s* 0 \s*$/x,
+::like( $prereq_out, qr/^perl\(strict\) \s* >= \s* 0 \s*$/x,
'prereqs dumped' );
diff --git a/lib/ExtUtils/t/recurs.t b/lib/ExtUtils/t/recurs.t
index 17da39e..8e261b2 100644
--- a/lib/ExtUtils/t/recurs.t
+++ b/lib/ExtUtils/t/recurs.t
@@ -24,7 +24,6 @@ use MakeMaker::Test::Setup::Recurs;
delete @ENV{qw(PREFIX LIB MAKEFLAGS)};
my $perl = which_perl();
-my $Is_VMS = $^O eq 'VMS';
chdir('t');
@@ -35,7 +34,7 @@ my $Touch_Time = calibrate_mtime();
$| = 1;
ok( setup_recurs(), 'setup' );
-END {
+END {
ok( chdir File::Spec->updir );
ok( teardown_recurs(), 'teardown' );
}
@@ -106,9 +105,9 @@ ok( -e $submakefile, 'sub Makefile written' );
my $inst_script = File::Spec->catdir(File::Spec->updir, 'cgi');
ok( open(MAKEFILE, $submakefile) ) || diag("Can't open $submakefile: $!");
-{ local $/;
- like( <MAKEFILE>, qr/^\s*INST_SCRIPT\s*=\s*\Q$inst_script\E/m,
- 'prepend .. not stomping WriteMakefile args' )
+{ local $/;
+ like( <MAKEFILE>, qr/^\s*INST_SCRIPT\s*=\s*\Q$inst_script\E/m,
+ 'prepend .. not stomping WriteMakefile args' )
}
close MAKEFILE;
@@ -119,4 +118,4 @@ close MAKEFILE;
my $test_out = run("$make test");
isnt $?, 0, 'test failure in a subdir causes make to fail';
-}
\ No newline at end of file
+}
diff --git a/lib/ExtUtils/t/split_command.t b/lib/ExtUtils/t/split_command.t
index a92f1a5..36b4341 100644
--- a/lib/ExtUtils/t/split_command.t
+++ b/lib/ExtUtils/t/split_command.t
@@ -15,9 +15,6 @@ chdir 't';
use ExtUtils::MM;
use MakeMaker::Test::Utils;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_Win32 = $^O eq 'MSWin32';
-
use Test::More tests => 7;
my $perl = which_perl;
@@ -55,10 +52,10 @@ sub _run {
my @cmds = @_;
s{\$\(ABSPERLRUN\)}{$perl} foreach @cmds;
- if( $Is_VMS ) {
+ if( $Is{VMS} ) {
s{-\n}{} foreach @cmds
}
- elsif( $Is_Win32 ) {
+ elsif( $Is{Win32} ) {
s{\\\n}{} foreach @cmds;
}
diff --git a/lib/ExtUtils/t/xs.t b/lib/ExtUtils/t/xs.t
index cab5204..73a556e 100644
--- a/lib/ExtUtils/t/xs.t
+++ b/lib/ExtUtils/t/xs.t
@@ -17,6 +17,7 @@ use MakeMaker::Test::Setup::XS;
use File::Find;
use File::Spec;
use File::Path;
+use vars '%Is';
if( have_compiler() ) {
plan tests => 5;
@@ -25,11 +26,10 @@ else {
plan skip_all => "ExtUtils::CBuilder not installed or couldn't find a compiler";
}
-my $Is_VMS = $^O eq 'VMS';
my $perl = which_perl();
# GNV logical interferes with testing
-$ENV{'bin'} = '[.bin]' if $Is_VMS;
+$ENV{'bin'} = '[.bin]' if $Is{VMS};
chdir 't';
@@ -53,9 +53,9 @@ cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) ||
my $make = make_run();
my $make_out = run("$make");
-is( $?, 0, ' make exited normally' ) ||
+is( $?, 0, ' make exited normally' ) ||
diag $make_out;
my $test_out = run("$make");
-is( $?, 0, ' make test exited normally' ) ||
+is( $?, 0, ' make test exited normally' ) ||
diag $test_out;
diff --git a/lib/File/Path.t b/lib/File/Path.t
index 3ecd8f6..bc4da24 100755
--- a/lib/File/Path.t
+++ b/lib/File/Path.t
@@ -1,6 +1,7 @@
# Path.t -- tests for module File::Path
use strict;
+use vars '%Is';
use Test::More tests => 120;
use Config;
@@ -14,8 +15,6 @@ BEGIN {
eval "use Test::Output";
my $has_Test_Output = $@ ? 0 : 1;
-my $Is_VMS = $^O eq 'VMS';
-
# first check for stupid permissions second for full, so we clean up
# behind ourselves
for my $perm (0111,0777) {
@@ -185,7 +184,7 @@ is(scalar(@created), 0, "skipped making existing directories (old style 1)")
$dir = catdir($tmp_base,'C');
# mkpath returns unix syntax filespecs on VMS
-$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+$dir = VMS::Filespec::unixify($dir) if $Is{VMS};
@created = make_path($tmp_base, $dir);
is(scalar(@created), 1, "created directory (new style 1)");
is($created[0], $dir, "created directory (new style 1) cross-check");
@@ -196,7 +195,7 @@ is(scalar(@created), 0, "skipped making existing directories (old style 2)")
$dir2 = catdir($tmp_base,'D');
# mkpath returns unix syntax filespecs on VMS
-$dir2 = VMS::Filespec::unixify($dir2) if $Is_VMS;
+$dir2 = VMS::Filespec::unixify($dir2) if $Is{VMS};
@created = make_path($tmp_base, $dir, $dir2);
is(scalar(@created), 1, "created directory (new style 2)");
is($created[0], $dir2, "created directory (new style 2) cross-check");
@@ -205,7 +204,7 @@ $count = rmtree($dir, 0);
is($count, 1, "removed directory unsafe mode");
$count = rmtree($dir2, 0, 1);
-my $removed = $Is_VMS ? 0 : 1;
+my $removed = $Is{VMS} ? 0 : 1;
is($count, $removed, "removed directory safe mode");
# mkdir foo ./E/../Y
@@ -241,7 +240,7 @@ ok(-d $dir2, "dir z still exists");
$dir = catdir($tmp_base,'F');
# mkpath returns unix syntax filespecs on VMS
-$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+$dir = VMS::Filespec::unixify($dir) if $Is{VMS};
@created = mkpath($dir, undef, 0770);
is(scalar(@created), 1, "created directory (old style 2 verbose undef)");
@@ -259,7 +258,7 @@ is($created[0], $dir, "created directory (old style 3 mode undef) cross-check");
is(rmtree($dir, 0, undef), 1, "removed directory 3 verbose undef");
$dir = catdir($tmp_base,'G');
-$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+$dir = VMS::Filespec::unixify($dir) if $Is{VMS};
@created = mkpath($dir, undef, 0200);
is(scalar(@created), 1, "created write-only dir");
@@ -426,14 +425,14 @@ SKIP: {
unless -e $dir;
$dir = catdir('EXTRA', '3', 'U');
- stderr_like(
+ stderr_like(
sub {rmtree($dir, {verbose => 0})},
qr{\Acannot make child directory read-write-exec for [^:]+: .* at \S+ line \d+},
q(rmtree can't chdir into root dir)
);
$dir = catdir('EXTRA', '3');
- stderr_like(
+ stderr_like(
sub {rmtree($dir, {})},
qr{\Acannot make child directory read-write-exec for [^:]+: .* at (\S+) line (\d+)
cannot make child directory read-write-exec for [^:]+: .* at \1 line \2
@@ -442,7 +441,7 @@ cannot remove directory for [^:]+: .* at \1 line \2},
'rmtree with file owned by root'
);
- stderr_like(
+ stderr_like(
sub {rmtree('EXTRA', {})},
qr{\Acannot remove directory for [^:]+: .* at (\S+) line (\d+)
cannot remove directory for [^:]+: .* at \1 line \2
@@ -552,11 +551,11 @@ SKIP: {
rmtree($tmp_base, {result => \$list} );
is(ref($list), 'ARRAY', "received a final list of results");
ok( !(-d $tmp_base), "test base directory gone" );
-
+
my $p = getcwd();
my $x = "x$$";
my $xx = $x . "x";
-
+
# setup
ok(mkpath($xx));
ok(chdir($xx));
@@ -564,7 +563,7 @@ SKIP: {
ok(chdir($p));
ok(rmtree($xx));
}
-
+
# create and delete directory
my $px = catdir($p, $x);
ok(mkpath($px));
diff --git a/lib/Shell.t b/lib/Shell.t
index 13bba22..8682c84 100644
--- a/lib/Shell.t
+++ b/lib/Shell.t
@@ -14,10 +14,6 @@ BEGIN { use_ok('Shell'); }
my $so = Shell->new;
ok($so, 'Shell->new');
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
-
$Shell::capture_stderr = 1;
# Now test that that works ..
@@ -28,7 +24,7 @@ while ( -f $tmpfile ) {
}
END { -f $tmpfile && (open STDERR, '>&SAVERR' and unlink $tmpfile) }
-no warnings 'once';
+no warnings 'once';
# no false warning about Name "main::SAVERR" used only once: possible typo
open(SAVERR, ">&STDERR");
@@ -51,7 +47,7 @@ if ($ENV{PERL_CORE} && -d 'uni') {
# someone will have to fill in the blanks for other platforms
-if ($Is_VMS) {
+if ($Is{VMS}) {
ok(directory(), 'Execute command');
my @files = directory('*.*');
ok(@files, 'Quoted arguments');
@@ -59,7 +55,7 @@ if ($Is_VMS) {
ok(eq_array(\@files, [$so->directory('*.*')]), 'object method');
eval { $so->directory };
ok(!$@, '2 methods calls');
-} elsif ($Is_MSWin32) {
+} elsif ($Is{MSWin32}) {
ok(dir(), 'Execute command');
my @files = dir('*.*');
ok(@files, 'Quoted arguments');
diff --git a/lib/blib.t b/lib/blib.t
index a959471..b3c7bab 100644
--- a/lib/blib.t
+++ b/lib/blib.t
@@ -6,14 +6,14 @@ BEGIN {
}
use strict;
+use vars '%Is';
use File::Spec;
my($blib, $blib_arch, $blib_lib, @blib_dirs);
-my $Is_VMS = $^O eq 'VMS';
my $Is_VMS_mode = 0;
-if ($Is_VMS) {
- require VMS::Filespec if $Is_VMS;
+if ($Is{VMS}) {
+ require VMS::Filespec if $Is{VMS};
my $vms_unix_rpt;
$Is_VMS_mode = 1;
@@ -21,7 +21,7 @@ if ($Is_VMS) {
$vms_unix_rpt = VMS::Feature::current("filename_unix_report");
} else {
my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
- $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
}
$Is_VMS_mode = 0 if ($vms_unix_rpt);
}
@@ -38,7 +38,7 @@ sub _mkdirs {
mkdir $dir or die "Can't mkdir $dir: $!" if ! -d $dir;
}
}
-
+
BEGIN {
if ($^O eq 'MacOS')
diff --git a/lib/strict.t b/lib/strict.t
index bfe6b63..a822425 100644
--- a/lib/strict.t
+++ b/lib/strict.t
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl
BEGIN {
chdir 't' if -d 't';
@@ -9,9 +9,6 @@ BEGIN {
$| = 1;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
my $i = 0 ;
my @prgs = () ;
@@ -35,8 +32,8 @@ foreach (sort glob($^O eq 'MacOS' ? ":lib:strict:*" : "lib/strict/*")) {
undef $/;
print "1.." . (@prgs + 4) . "\n";
-
-
+
+
for (@prgs){
my $switch = "";
my @temps = () ;
@@ -47,7 +44,7 @@ for (@prgs){
if ( $prog =~ /--FILE--/) {
my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
shift @files ;
- die "Internal error test $i didn't split into pairs, got " .
+ die "Internal error test $i didn't split into pairs, got " .
scalar(@files) . "[" . join("%%%%", @files) ."]\n"
if @files % 2 ;
while (@files > 2) {
@@ -67,7 +64,7 @@ for (@prgs){
open TEST, ">$tmpfile" or die "Could not open: $!";
print TEST $prog,"\n";
close TEST or die "Could not close: $!";
- my $results = $Is_MSWin32 ?
+ my $results = $Is{MSWin32} ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
$^O eq 'NetWare' ?
`perl -I../lib $switch $tmpfile 2>&1` :
@@ -78,7 +75,7 @@ for (@prgs){
$results =~ s/\n+$//;
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+[A-Z][A-Z]?/-/g;
- $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+ $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is{VMS}; # clip off DCL status msg
$expected =~ s/\n+$//;
$expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
$expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
@@ -97,8 +94,8 @@ for (@prgs){
print "not ";
}
print "ok " . ++$i . ($TODO ? " # TODO" : "") . "\n";
- foreach (@temps)
- { unlink $_ if $_ }
+ foreach (@temps)
+ { unlink $_ if $_ }
}
eval qq(use strict 'garbage');
diff --git a/lib/subs.t b/lib/subs.t
index b1999b2..9b87003 100644
--- a/lib/subs.t
+++ b/lib/subs.t
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl
BEGIN {
chdir 't' if -d 't';
@@ -12,10 +12,6 @@ undef $/;
my @prgs = split "\n########\n", <DATA>;
print "1..", scalar @prgs, "\n";
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
-my $Is_MacOS = $^O eq 'MacOS';
my $i = 0 ;
for (@prgs){
@@ -28,7 +24,7 @@ for (@prgs){
if ( $prog =~ /--FILE--/) {
my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
shift @files ;
- die "Internal error test $i didn't split into pairs, got " .
+ die "Internal error test $i didn't split into pairs, got " .
scalar(@files) . "[" . join("%%%%", @files) ."]\n"
if @files % 2 ;
while (@files > 2) {
@@ -46,20 +42,20 @@ for (@prgs){
open TEST, ">$tmpfile";
print TEST $prog,"\n";
close TEST;
- my $results = $Is_VMS ?
+ my $results = $Is{VMS} ?
`./perl $switch $tmpfile 2>&1` :
- $Is_MSWin32 ?
+ $Is{MSWin32} ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
- $Is_NetWare ?
+ $Is{NetWare} ?
`perl -I../lib $switch $tmpfile 2>&1` :
- $Is_MacOS ?
+ $Is{MacOS} ?
`$^X -I::lib -MMac::err=unix $switch $tmpfile` :
`./perl $switch $tmpfile 2>&1`;
my $status = $?;
$results =~ s/\n+$//;
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+[A-Z][A-Z]?/-/g;
- $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+ $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is{VMS}; # clip off DCL status msg
# bison says 'parse error' instead of 'syntax error',
# various yaccs may or may not capitalize 'syntax'.
$results =~ s/^(syntax|parse) error/syntax error/mig;
@@ -76,8 +72,8 @@ for (@prgs){
print "not ";
}
print "ok ", ++$i, "\n";
- foreach (@temps)
- { unlink $_ if $_ }
+ foreach (@temps)
+ { unlink $_ if $_ }
}
__END__
diff --git a/t/comp/require.t b/t/comp/require.t
index 0746b3b..7c07c9d 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -13,10 +13,8 @@ my @fjles_to_delete = qw (bleah.pm bleah.do bleah.flg urkkk.pm urkkk.pmc
krunch.pm krunch.pmc whap.pm whap.pmc);
-my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
-my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
my $total_tests = 50;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
+if ($Is{EBCDIC} || $Is{UTF8}) { $total_tests -= 3; }
print "1..$total_tests\n";
sub do_require {
@@ -279,7 +277,7 @@ EOT
# UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input
-if ($Is_EBCDIC || $Is_UTF8) { exit; }
+if ($Is{EBCDIC} || $Is{UTF8}) { exit; }
my $utf8 = chr(0xFEFF);
diff --git a/t/io/fs.t b/t/io/fs.t
index 8c45c8d..27834e0 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -9,9 +9,6 @@ BEGIN {
use Config;
use File::Spec::Functions;
-my $Is_MacOS = ($^O eq 'MacOS');
-my $Is_VMSish = ($^O eq 'VMS');
-
if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
$wd = `cd`;
}
@@ -29,7 +26,7 @@ my $accurate_timestamps =
$^O eq 'dos' || $^O eq 'os2' ||
$^O eq 'mint' || $^O eq 'cygwin' ||
$^O eq 'amigaos' || $wd =~ m#$Config{afsroot}/# ||
- $Is_MacOS
+ $Is{MacOS}
);
if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
@@ -64,7 +61,7 @@ elsif ($^O eq 'VMS') {
`if f\$search("$tmpdir.dir") .nes. "" then delete/nolog/noconfirm $tmpdir.dir;`;
`create/directory [.$tmpdir]`;
}
-elsif ($Is_MacOS) {
+elsif ($Is{MacOS}) {
rmdir "$tmpdir"; mkdir "$tmpdir";
}
else {
@@ -78,7 +75,7 @@ chdir catdir(curdir(), $tmpdir);
umask(022);
SKIP: {
- skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'epoc') || $Is_MacOS;
+ skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'epoc') || $Is{MacOS};
is((umask(0)&0777), 022, 'umask'),
}
@@ -115,8 +112,8 @@ SKIP: {
# if ($^O eq 'cygwin') { # new files on cygwin get rwx instead of rw-
# is($mode & 0777, 0777, "mode of triply-linked file");
# } else {
- is(sprintf("0%o", $mode & 0777),
- sprintf("0%o", $a_mode & 0777),
+ is(sprintf("0%o", $mode & 0777),
+ sprintf("0%o", $a_mode & 0777),
"mode of triply-linked file");
# }
}
@@ -186,7 +183,7 @@ SKIP: {
}
is(chmod($newmode, "a"), 1, "fchmod");
$mode = (stat $fh)[2];
- SKIP: {
+ SKIP: {
skip "no mode checks", 1 if $skip_mode_checks;
is($mode & 0777, $newmode, "perm restored");
}
diff --git a/t/io/open.t b/t/io/open.t
index 325d637..41bd1f9 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -9,7 +9,6 @@ BEGIN {
$| = 1;
use warnings;
use Config;
-$Is_MacOS = $^O eq 'MacOS';
plan tests => 108;
@@ -34,7 +33,7 @@ my $afile = tempfile();
eval { die "Message" };
like( $@, qr/<\$f> line 1/, ' die message correct' );
-
+
ok( close($f), ' close()' );
ok( unlink($afile), ' unlink()' );
}
@@ -85,7 +84,7 @@ EOC
ok( close($f), ' close' );
}
SKIP: {
- skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS;
+ skip "Output for |- doesn't go to shell on MacOS", 5 if $Is{MacOS};
ok( open(my $f, '|-', <<EOC), 'open |-' );
$Perl -pe "s/^not //"
@@ -178,7 +177,7 @@ EOC
}
SKIP: {
- skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS;
+ skip "Output for |- doesn't go to shell on MacOS", 5 if $Is{MacOS};
ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' );
$Perl -pe "s/^not //"
@@ -276,7 +275,7 @@ SKIP: {
gimme($fh3{k});
like($@, qr/<\$fh3{...}> line 1\./, "autoviv fh lexical helem");
}
-
+
SKIP: {
skip("These tests use perlio", 5) unless $Config{useperlio};
my $w;
diff --git a/t/io/tell.t b/t/io/tell.t
index 09b61a3..7b2be5c 100755
--- a/t/io/tell.t
+++ b/t/io/tell.t
@@ -10,12 +10,8 @@ print "1..28\n";
$TST = 'TST';
-$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'dos' or
- $^O eq 'os2' or $^O eq 'mint' or $^O eq 'cygwin' or
- $^O =~ /^uwin/);
-
open($TST, 'harness') || (die "Can't open harness");
-binmode $TST if $Is_Dosish;
+binmode $TST if $Is{Dosish};
if (eof(TST)) { print "not ok 1\n"; } else { print "ok 1\n"; }
$firstline = <$TST>;
@@ -106,7 +102,7 @@ my $written = tempfile();
close($TST);
open($tst,">$written") || die "Cannot open $written:$!";
-binmode $tst if $Is_Dosish;
+binmode $tst if $Is{Dosish};
if (tell($tst) == 0) { print "ok 24\n"; } else { print "not ok 24\n"; }
@@ -121,11 +117,11 @@ if (tell($tst) == 10) { print "ok 26\n"; } else { print "not ok 26\n"; }
close($tst);
open($tst,"+>>$written") || die "Cannot open $written:$!";
-binmode $tst if $Is_Dosish;
+binmode $tst if $Is{Dosish};
-if (0)
+if (0)
{
- # :stdio does not pass these so ignore them for now
+ # :stdio does not pass these so ignore them for now
if (tell($tst) == 0) { print "ok 27\n"; } else { print "not ok 27\n"; }
diff --git a/t/lib/common.pl b/t/lib/common.pl
index ef95c9d..b3ed462 100644
--- a/t/lib/common.pl
+++ b/t/lib/common.pl
@@ -10,11 +10,11 @@ use File::Spec::Functions;
use strict;
use warnings;
+use vars '%Is';
our $pragma_name;
$| = 1;
-my $Is_MacOS = $^O eq 'MacOS';
my $tmpfile = tempfile();
my @prgs = () ;
@@ -22,7 +22,7 @@ my @w_files = () ;
if (@ARGV)
{ print "ARGV = [@ARGV]\n" ;
- if ($Is_MacOS) {
+ if ($Is{MacOS}) {
@w_files = map { s#^#:lib:$pragma_name:#; $_ } @ARGV
} else {
@w_files = map { s#^#./lib/$pragma_name/#; $_ } @ARGV
@@ -108,7 +108,7 @@ for (@prgs){
}
# fix up some paths
- if ($Is_MacOS) {
+ if ($Is{MacOS}) {
$prog =~ s|require "./abc(d)?";|require ":abc$1";|g;
$prog =~ s|"\."|":"|g;
}
@@ -142,7 +142,7 @@ for (@prgs){
$results =~ s/Scalars leaked: \d+\n//g;
# fix up some paths
- if ($Is_MacOS) {
+ if ($Is{MacOS}) {
$results =~ s|:abc\.pm\b|abc.pm|g;
$results =~ s|:abc(d)?\b|./abc$1|g;
}
@@ -184,7 +184,7 @@ for (@prgs){
else {
$ok = $results eq $expected;
}
-
+
local $::TODO = $reason{todo};
print_err_line( $switch, $prog, $expected, $results, $::TODO ) unless $ok;
diff --git a/t/op/anonsub.t b/t/op/anonsub.t
index 970440b..a1dbe1d 100755
--- a/t/op/anonsub.t
+++ b/t/op/anonsub.t
@@ -6,11 +6,7 @@
chdir 't' if -d 't';
@INC = '../lib';
-$Is_VMS = $^O eq 'VMS';
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_MacOS = $^O eq 'MacOS';
-$Is_NetWare = $^O eq 'NetWare';
-$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
+$ENV{PERL5LIB} = "../lib" unless $Is{VMS};
$|=1;
@@ -31,20 +27,20 @@ for (@prgs){
open TEST, ">$tmpfile";
print TEST "$prog\n";
close TEST or die "Could not close: $!";
- my $results = $Is_VMS ?
+ my $results = $Is{VMS} ?
`$^X "-I[-.lib]" $switch $tmpfile 2>&1` :
- $Is_MSWin32 ?
+ $Is{MSWin32} ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
- $Is_MacOS ?
+ $Is{MacOS} ?
`$^X -I::lib $switch $tmpfile` :
- $Is_NetWare ?
+ $Is{NetWare} ?
`perl -I../lib $switch $tmpfile 2>&1` :
`./perl $switch $tmpfile 2>&1`;
my $status = $?;
$results =~ s/\n+$//;
# allow expected output to be written as if $prog is on STDIN
$results =~ s/runltmp\d+/-/g;
- $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+ $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is{VMS}; # clip off DCL status msg
$expected =~ s/\n+$//;
if ($results ne $expected) {
print STDERR "PROG: $switch\n$prog\n";
diff --git a/t/op/bop.t b/t/op/bop.t
index b7f82ee..c53844b 100755
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -100,13 +100,11 @@ is (sprintf("%vd", $a), '248.444');
# UTF8 ~ behaviour
#
-my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
-
my @not36;
for (0x100...0xFFF) {
$a = ~(chr $_);
- if ($Is_EBCDIC) {
+ if ($Is{EBCDIC}) {
push @not36, sprintf("%#03X", $_)
if $a ne chr(~$_) or length($a) != 1;
}
@@ -122,7 +120,7 @@ my @not37;
for my $i (0xEEE...0xF00) {
for my $j (0x0..0x120) {
$a = ~(chr ($i) . chr $j);
- if ($Is_EBCDIC) {
+ if ($Is{EBCDIC}) {
push @not37, sprintf("%#03X %#03X", $i, $j)
if $a ne chr(~$i).chr(~$j) or
length($a) != 2;
@@ -130,7 +128,7 @@ for my $i (0xEEE...0xF00) {
else {
push @not37, sprintf("%#03X %#03X", $i, $j)
if $a ne chr(~$i).chr(~$j) or
- length($a) != 2 or
+ length($a) != 2 or
~$a ne chr($i).chr($j);
}
}
@@ -138,7 +136,7 @@ for my $i (0xEEE...0xF00) {
is (join (', ', @not37), '');
SKIP: {
- skip "EBCDIC" if $Is_EBCDIC;
+ skip "EBCDIC" if $Is{EBCDIC};
is (~chr(~0), "\0");
}
@@ -415,7 +413,7 @@ SKIP: {
# update to pp_complement() via Coverity
SKIP: {
# UTF-EBCDIC is limited to 0x7fffffff and can't encode ~0.
- skip "EBCDIC" if $Is_EBCDIC;
+ skip "EBCDIC" if $Is{EBCDIC};
my $str = "\x{10000}\x{800}";
# U+10000 is four bytes in UTF-8/UTF-EBCDIC.
diff --git a/t/op/exec.t b/t/op/exec.t
index 91821aa..efbb746 100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -14,7 +14,7 @@ if ($^O eq 'VMS') {
} else {
my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
my $env_posix_ex = $ENV{'PERL_VMS_POSIX_EXIT'} || '';
- my $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
+ my $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
my $posix_ex = $env_posix_ex =~ /^[ET1]/i;
if (($unix_rpt || $posix_ex) ) {
$vms_exit_mode = 0;
@@ -33,9 +33,6 @@ $| = 1; # flush stdout
$ENV{LC_ALL} = 'C'; # Forge English error messages.
$ENV{LANGUAGE} = 'C'; # Ditto in GNU.
-my $Is_VMS = $^O eq 'VMS';
-my $Is_Win32 = $^O eq 'MSWin32';
-
skip_all("Tests mostly usesless on MacOS") if $^O eq 'MacOS';
plan(tests => 22);
@@ -59,9 +56,9 @@ is( $exit, 0, ' exited 0' );
# On VMS and Win32 you need the quotes around the program or it won't work.
# On Unix its the opposite.
-my $quote = $Is_VMS || $Is_Win32 ? '"' : '';
+my $quote = $Is{VMS} || $Is{Win32} ? '"' : '';
$tnum = curr_test();
-$exit = system $Perl, '-le',
+$exit = system $Perl, '-le',
"${quote}print q{ok $tnum - system(PROG, LIST)}${quote}";
next_test();
is( $exit, 0, ' exited 0' );
@@ -77,25 +74,25 @@ is( $echo_out, "ok\n", 'piped echo emulation');
{
# here we check if extra newlines are going to be slapped on
# piped output.
- local $TODO = 'VMS sticks newlines on everything' if $Is_VMS;
+ local $TODO = 'VMS sticks newlines on everything' if $Is{VMS};
is( scalar `$Perl -e "print 'ok'"`,
"ok", 'no extra newlines on ``' );
- is( scalar `$Perl -e "print 'ok'" | $Perl -e "print <STDIN>"`,
+ is( scalar `$Perl -e "print 'ok'" | $Perl -e "print <STDIN>"`,
"ok", 'no extra newlines on pipes');
- is( scalar `$Perl -le "print 'ok'" | $Perl -le "print <STDIN>"`,
+ is( scalar `$Perl -le "print 'ok'" | $Perl -le "print <STDIN>"`,
"ok\n\n", 'doubled up newlines');
- is( scalar `$Perl -e "print 'ok'" | $Perl -le "print <STDIN>"`,
+ is( scalar `$Perl -e "print 'ok'" | $Perl -le "print <STDIN>"`,
"ok\n", 'extra newlines on inside pipes');
- is( scalar `$Perl -le "print 'ok'" | $Perl -e "print <STDIN>"`,
+ is( scalar `$Perl -le "print 'ok'" | $Perl -e "print <STDIN>"`,
"ok\n", 'extra newlines on outgoing pipes');
{
- local($/) = \2;
+ local($/) = \2;
$out = runperl(prog => 'print q{1234}');
is($out, "1234", 'ignore $/ when capturing output in scalar context');
}
@@ -113,7 +110,7 @@ unless( ok($rc == 255 << 8 or $rc == -1 or $rc == 256 or $rc == 512) ) {
print "# \$rc == $rc\n";
}
-unless ( ok( $! == 2 or $! =~ /\bno\b.*\bfile/i or
+unless ( ok( $! == 2 or $! =~ /\bno\b.*\bfile/i or
$! == 13 or $! =~ /permission denied/i or
$! == 22 or $! =~ /invalid argument/i ) ) {
printf "# \$! eq %d, '%s'\n", $!, $!;
@@ -139,7 +136,7 @@ TODO: {
last TODO;
}
- ok( !exec("lskdjfalksdjfdjfkls"),
+ ok( !exec("lskdjfalksdjfdjfkls"),
"exec failure doesn't terminate process");
}
diff --git a/t/op/magic.t b/t/op/magic.t
index fd2307b..227e5bd 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -13,34 +13,34 @@ use Config;
plan (tests => 79);
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$Is_VMS = $^O eq 'VMS';
-$Is_Dos = $^O eq 'dos';
-$Is_os2 = $^O eq 'os2';
-$Is_Cygwin = $^O eq 'cygwin';
-$Is_MacOS = $^O eq 'MacOS';
-$Is_MPE = $^O eq 'mpeix';
-$Is_miniperl = $ENV{PERL_CORE_MINITEST};
-$Is_BeOS = $^O eq 'beos';
+$Is{MSWin32} = $^O eq 'MSWin32';
+$Is{NetWare} = $^O eq 'NetWare';
+$Is{VMS} = $^O eq 'VMS';
+$Is{Dos} = $^O eq 'dos';
+$Is{os2} = $^O eq 'os2';
+$Is{Cygwin} = $^O eq 'cygwin';
+$Is{MacOS} = $^O eq 'MacOS';
+$Is{MPE} = $^O eq 'mpeix';
+$Is{miniperl} = $ENV{PERL_CORE_MINITEST};
+$Is{BeOS} = $^O eq 'beos';
$PERL = $ENV{PERL}
- || ($Is_NetWare ? 'perl' :
- ($Is_MacOS || $Is_VMS) ? $^X :
- $Is_MSWin32 ? '.\perl' :
+ || ($Is{NetWare} ? 'perl' :
+ ($Is{MacOS} || $Is{VMS}) ? $^X :
+ $Is{MSWin32} ? '.\perl' :
'./perl');
END {
# On VMS, environment variable changes are peristent after perl exits
- delete $ENV{'FOO'} if $Is_VMS;
+ delete $ENV{'FOO'} if $Is{VMS};
}
eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval
# cmd.exe will echo 'variable=value' but 4nt will echo just the value
# -- Nikola Knezevic
-if ($Is_MSWin32) { like `set FOO`, qr/^(?:FOO=)?hi there$/; }
-elsif ($Is_MacOS) { ok "1 # skipped", 1; }
-elsif ($Is_VMS) { is `write sys\$output f\$trnlnm("FOO")`, "hi there\n"; }
+if ($Is{MSWin32}) { like `set FOO`, qr/^(?:FOO=)?hi there$/; }
+elsif ($Is{MacOS}) { ok "1 # skipped", 1; }
+elsif ($Is{VMS}) { is `write sys\$output f\$trnlnm("FOO")`, "hi there\n"; }
else { is `echo \$FOO`, "hi there\n"; }
unlink 'ajslkdfpqjsjfk';
@@ -51,7 +51,7 @@ close FOO; # just mention it, squelch used-only-once
SKIP: {
skip('SIGINT not safe on this platform', 5)
- if $Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS;
+ if $Is{MSWin32} || $Is{NetWare} || $Is{Dos} || $Is{MPE} || $Is{MacOS};
# the next tests are done in a subprocess because sh spits out a
# newline onto stderr when a child process kills itself with SIGINT.
# We use a pipe rather than system() because the VMS command buffer
@@ -163,7 +163,7 @@ is((keys %h)[0], "foo\034bar");
# $?, $@, $$
SKIP: {
- skip('$? + system are broken on MacPerl', 2) if $Is_MacOS;
+ skip('$? + system are broken on MacPerl', 2) if $Is{MacOS};
system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(0)"];
is $?, 0;
system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(1)"];
@@ -182,29 +182,29 @@ like ($@, qr/^Modification of a read-only value attempted/);
if ($^O eq 'qnx') {
chomp($wd = `/usr/bin/fullpath -t`);
}
- elsif($Is_Cygwin || $Config{'d_procselfexe'}) {
+ elsif($Is{Cygwin} || $Config{'d_procselfexe'}) {
# Cygwin turns the symlink into the real file
chomp($wd = `pwd`);
$wd =~ s#/t$##;
- if ($Is_Cygwin) {
+ if ($Is{Cygwin}) {
$wd = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($wd, 1));
}
}
- elsif($Is_os2) {
+ elsif($Is{os2}) {
$wd = Cwd::sys_cwd();
}
- elsif($Is_MacOS) {
+ elsif($Is{MacOS}) {
$wd = ':';
}
else {
$wd = '.';
}
- my $perl = ($Is_MacOS || $Is_VMS) ? $^X : "$wd/perl";
+ my $perl = ($Is{MacOS} || $Is{VMS}) ? $^X : "$wd/perl";
my $headmaybe = '';
my $middlemaybe = '';
my $tailmaybe = '';
$script = "$wd/show-shebang";
- if ($Is_MSWin32) {
+ if ($Is{MSWin32}) {
chomp($wd = `cd`);
$wd =~ s|\\|/|g;
$perl = "$wd/perl.exe";
@@ -222,16 +222,16 @@ __END__
:endofperl
EOT
}
- elsif ($Is_os2) {
+ elsif ($Is{os2}) {
$script = "./show-shebang";
}
- elsif ($Is_MacOS) {
+ elsif ($Is{MacOS}) {
$script = ":show-shebang";
}
- elsif ($Is_VMS) {
+ elsif ($Is{VMS}) {
$script = "[]show-shebang";
}
- elsif ($Is_Cygwin) {
+ elsif ($Is{Cygwin}) {
$middlemaybe = <<'EOX'
$^X = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($^X, 1));
$0 = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($0, 1));
@@ -252,22 +252,22 @@ print "\$^X is $^X, \$0 is $0\n";
EOF
ok close(SCRIPT) or diag $!;
ok chmod(0755, $script) or diag $!;
- $_ = ($Is_MacOS || $Is_VMS) ? `$perl $script` : `$script`;
- s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
- s{./$script}{$script} if $Is_BeOS; # revert BeOS execvp() side-effect
+ $_ = ($Is{MacOS} || $Is{VMS}) ? `$perl $script` : `$script`;
+ s/\.exe//i if $Is{Dos} or $Is{Cygwin} or $Is{os2};
+ s{./$script}{$script} if $Is{BeOS}; # revert BeOS execvp() side-effect
s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
s{is perl}{is $perl}; # for systems where $^X is only a basename
s{\\}{/}g;
- if ($Is_MSWin32 || $Is_os2) {
+ if ($Is{MSWin32} || $Is{os2}) {
is uc $_, uc $s1;
} else {
is $_, $s1;
}
$_ = `$perl $script`;
- s/\.exe//i if $Is_Dos or $Is_os2 or $Is_Cygwin;
- s{./$perl}{$perl} if $Is_BeOS; # revert BeOS execvp() side-effect
+ s/\.exe//i if $Is{Dos} or $Is{os2} or $Is{Cygwin};
+ s{./$perl}{$perl} if $Is{BeOS}; # revert BeOS execvp() side-effect
s{\\}{/}g;
- if ($Is_MSWin32 || $Is_os2) {
+ if ($Is{MSWin32} || $Is{os2}) {
is uc $_, uc $s1;
} else {
is $_, $s1;
@@ -290,7 +290,7 @@ $^O = $orig_osname;
SKIP: {
skip("%ENV manipulations fail or aren't safe on $^O", 4)
- if $Is_VMS || $Is_Dos || $Is_MacOS;
+ if $Is{VMS} || $Is{Dos} || $Is{MacOS};
SKIP: {
skip("clearing \%ENV is not safe when running under valgrind")
@@ -302,7 +302,7 @@ SKIP: {
%ENV = ();
$ENV{PATH} = $PATH;
$ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
- if ($Is_MSWin32) {
+ if ($Is{MSWin32}) {
is `set foo 2>NUL`, "";
} else {
is `echo \$foo`, "\n";
@@ -313,7 +313,7 @@ SKIP: {
$0 = "bar";
# cmd.exe will echo 'variable=value' but 4nt will echo just the value
# -- Nikola Knezevic
- if ($Is_MSWin32) {
+ if ($Is{MSWin32}) {
like `set __NoNeSuCh`, qr/^(?:__NoNeSuCh=)?foo$/;
} else {
is `echo \$__NoNeSuCh`, "foo\n";
@@ -361,14 +361,14 @@ SKIP: {
my $warn = '';
local $SIG{'__WARN__'} = sub { $ok = 0; $warn = join '', @_; $warn =~ s/\n$//; };
$! = undef;
- local $TODO = $Is_VMS ? "'\$!=undef' does throw a warning" : '';
+ local $TODO = $Is{VMS} ? "'\$!=undef' does throw a warning" : '';
ok($ok, $warn);
}
# test case-insignificance of %ENV (these tests must be enabled only
# when perl is compiled with -DENV_IS_CASELESS)
SKIP: {
- skip('no caseless %ENV support', 4) unless $Is_MSWin32 || $Is_NetWare;
+ skip('no caseless %ENV support', 4) unless $Is{MSWin32} || $Is{NetWare};
%ENV = ();
$ENV{'Foo'} = 'bar';
@@ -380,7 +380,7 @@ SKIP: {
}
SKIP: {
- skip ("miniperl can't rely on loading %Errno", 2) if $Is_miniperl;
+ skip ("miniperl can't rely on loading %Errno", 2) if $Is{miniperl};
no warnings 'void';
# Make sure Errno hasn't been prematurely autoloaded
@@ -396,7 +396,7 @@ SKIP: {
}
SKIP: {
- skip ("miniperl can't rely on loading %Errno") if $Is_miniperl;
+ skip ("miniperl can't rely on loading %Errno") if $Is{miniperl};
# Make sure that Errno loading doesn't clobber $!
undef %Errno::;
@@ -457,7 +457,7 @@ is "@+", "10 1 6 10";
# Can not do this test on VMS, EPOC, and SYMBIAN according to comments
# in mg.c/Perl_magic_clear_all_env()
SKIP: {
- skip('Can\'t make assignment to \%ENV on this system', 3) if $Is_VMS;
+ skip('Can\'t make assignment to \%ENV on this system', 3) if $Is{VMS};
local @ISA;
local %ENV;
diff --git a/t/op/pack.t b/t/op/pack.t
index 4b5f9a5..d1bef61 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -17,8 +17,8 @@ plan tests => 14697;
use strict;
use warnings qw(FATAL all);
use Config;
+use vars '%Is';
-my $Is_EBCDIC = (defined $Config{ebcdic} && $Config{ebcdic} eq 'define');
my $Perl = which_perl();
my @valid_errors = (qr/^Invalid type '\w'/);
@@ -122,7 +122,7 @@ sub list_eq ($$) {
{
my $sum = 129; # ASCII
- $sum = 103 if $Is_EBCDIC;
+ $sum = 103 if $Is{EBCDIC};
my $x;
is( ($x = unpack("%32B*", "Now is the time for all good blurfl")), $sum );
@@ -861,7 +861,7 @@ SKIP: {
foreach (
['a/a*/a*', '212ab345678901234567','ab3456789012'],
['a/a*/a*', '3012ab345678901234567', 'ab3456789012'],
- ['a/a*/b*', '212ab', $Is_EBCDIC ? '100000010100' : '100001100100'],
+ ['a/a*/b*', '212ab', $Is{EBCDIC} ? '100000010100' : '100001100100'],
)
{
my ($pat, $in, $expect) = @$_;
@@ -910,14 +910,14 @@ EOP
SKIP: {
- skip("(EBCDIC and) version strings are bad idea", 2) if $Is_EBCDIC;
+ skip("(EBCDIC and) version strings are bad idea", 2) if $Is{EBCDIC};
is("1.20.300.4000", sprintf "%vd", pack("U*",1,20,300,4000));
is("1.20.300.4000", sprintf "%vd", pack(" U*",1,20,300,4000));
}
isnt(v1.20.300.4000, sprintf "%vd", pack("C0U*",1,20,300,4000));
-my $rslt = $Is_EBCDIC ? "156 67" : "199 162";
+my $rslt = $Is{EBCDIC} ? "156 67" : "199 162";
is(join(" ", unpack("U0 C*", chr(0x1e2))), $rslt);
# does pack U create Unicode?
@@ -934,7 +934,7 @@ is("@{[unpack('U*', pack('U*', 100, 200))]}", "100 200");
SKIP: {
- skip "Not for EBCDIC", 4 if $Is_EBCDIC;
+ skip "Not for EBCDIC", 4 if $Is{EBCDIC};
# does pack U0C create Unicode?
is("@{[pack('U0C*', 100, 195, 136)]}", v100.v200);
diff --git a/t/op/reg_mesg.t b/t/op/reg_mesg.t
index 4e8f3c4..93481fe 100644
--- a/t/op/reg_mesg.t
+++ b/t/op/reg_mesg.t
@@ -85,7 +85,7 @@ my @death =
'/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=barf=]{#}]/',
'/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions in regex; marked by {#} in m/[[.barf.]{#}]/',
-
+
'/[z-a]/' => 'Invalid [] range "z-a" in regex; marked by {#} in m/[z-a{#}]/',
'/\p/' => 'Empty \p{} in regex; marked by {#} in m/\p{#}/',
@@ -113,9 +113,9 @@ my @death =
my $total = (@death + @warning)/2;
# utf8 is a noop on EBCDIC platforms, it is not fatal
-my $Is_EBCDIC = (ord('A') == 193);
-if ($Is_EBCDIC) {
- my @utf8_death = grep(/utf8/, @death);
+
+if ($Is{EBCDIC}) {
+ my @utf8_death = grep(/utf8/, @death);
$total = $total - @utf8_death;
}
@@ -128,7 +128,7 @@ while (@death)
my $regex = shift @death;
my $result = shift @death;
# skip the utf8 test on EBCDIC since they do not die
- next if ($Is_EBCDIC && $regex =~ /utf8/);
+ next if ($Is{EBCDIC} && $regex =~ /utf8/);
$count++;
$_ = "x";
diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index 44aedc0..414b494 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -9,11 +9,7 @@
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
-$Is_VMS = $^O eq 'VMS';
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$Is_MacOS = $^O eq 'MacOS';
-$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
+$ENV{PERL5LIB} = "../lib" unless $Is{VMS};
$|=1;
@@ -32,20 +28,20 @@ for (@prgs){
open TEST, ">$tmpfile";
print TEST "$prog\n";
close TEST or die "Could not close: $!";
- my $results = $Is_VMS ?
+ my $results = $Is{VMS} ?
`$^X "-I[-.lib]" $switch $tmpfile 2>&1` :
- $Is_MSWin32 ?
+ $Is{MSWin32} ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
- $Is_NetWare ?
+ $Is{NetWare} ?
`perl -I../lib $switch $tmpfile 2>&1` :
- $Is_MacOS ?
+ $Is{MacOS} ?
`$^X -I::lib -MMac::err=unix $switch $tmpfile` :
`./perl $switch $tmpfile 2>&1`;
my $status = $?;
$results =~ s/\n+$//;
# allow expected output to be written as if $prog is on STDIN
$results =~ s/$::tempfile_regexp/-/ig;
- $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+ $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is{VMS}; # clip off DCL status msg
$expected =~ s/\n+$//;
if ($results ne $expected) {
print STDERR "PROG: $switch\n$prog\n";
@@ -65,7 +61,7 @@ EXPECT
Can't "last" outside a loop block at - line 3.
########
package TEST;
-
+
sub TIESCALAR {
my $foo;
return bless \$foo;
@@ -76,7 +72,7 @@ sub FETCH {
return ">$@<";
}
package main;
-
+
tie $bar, TEST;
print "- $bar\n";
EXPECT
@@ -85,7 +81,7 @@ still in fetch
<
########
package TEST;
-
+
sub TIESCALAR {
my $foo;
eval('die("foo\n")');
@@ -95,9 +91,9 @@ sub TIESCALAR {
sub FETCH {
return "ZZZ";
}
-
+
package main;
-
+
tie $bar, TEST;
print "- $bar\n";
print "OK\n";
@@ -107,7 +103,7 @@ after eval
OK
########
package TEST;
-
+
sub TIEHANDLE {
my $foo;
return bless \$foo;
@@ -117,9 +113,9 @@ print STDERR "PRINT CALLED\n";
(split(/./, 'x'x10000))[0];
eval('die("test\n")');
}
-
+
package main;
-
+
open FH, ">&STDOUT";
tie *FH, TEST;
print FH "OK\n";
@@ -140,18 +136,18 @@ WARNHOOK
END
########
package TEST;
-
+
use overload
"\"\"" => \&str
;
-
+
sub str {
eval('die("test\n")');
return "STR";
}
-
+
package main;
-
+
$bar = bless {}, TEST;
print "$bar\n";
print "OK\n";
@@ -212,7 +208,7 @@ EXPECT
Label not found for "last foo" at - line 2.
########
package TEST;
-
+
sub TIESCALAR {
my $foo;
return bless \$foo;
@@ -223,9 +219,9 @@ sub FETCH {
}
sub STORE {
}
-
+
package main;
-
+
tie $bar, TEST;
{
print "- $bar\n";
@@ -235,7 +231,7 @@ EXPECT
Can't "next" outside a loop block at - line 8.
########
package TEST;
-
+
sub TIESCALAR {
my $foo;
return bless \$foo;
@@ -244,9 +240,9 @@ sub FETCH {
goto bbb;
return "ZZZ";
}
-
+
package main;
-
+
tie $bar, TEST;
print "- $bar\n";
exit;
@@ -311,7 +307,7 @@ $SIG{__DIE__} = sub {
eval { die };
&{sub { eval 'die' }}();
sub foo { eval { die } } foo();
-{package rmb; sub{ eval{die} } ->() }; # check __ANON__ knows package
+{package rmb; sub{ eval{die} } ->() }; # check __ANON__ knows package
EXPECT
In DIE
main|-|8|(eval)
@@ -326,7 +322,7 @@ rmb|-|11|(eval)
rmb|-|11|rmb::__ANON__
########
package TEST;
-
+
sub TIEARRAY {
return bless [qw(foo fee fie foe)], $_[0];
}
@@ -338,10 +334,10 @@ sub FETCH {
bbb:
return $s->[$i];
}
-
+
package main;
tie my @bar, 'TEST';
-print join('|', @bar[0..3]), "\n";
+print join('|', @bar[0..3]), "\n";
EXPECT
foo|fee|fie|foe
########
@@ -393,7 +389,7 @@ EXPECT
[TIE] DIE
########
sub TIEHANDLE { bless {} }
-sub PRINT {
+sub PRINT {
(split(/./, 'x'x10000))[0];
eval('die("test\n")');
warn "[TIE] $_[1]";
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index ba77e64..78284f7 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -14,21 +14,11 @@ use warnings;
use version;
use Config;
use strict;
+use vars '%Is';
my @tests = ();
my ($i, $template, $data, $result, $comment, $w, $x, $evalData, $n, $p);
-my $Is_VMS_VAX = 0;
-# We use HW_MODEL since ARCH_NAME was not in VMS V5.*
-if ($^O eq 'VMS') {
- my $hw_model;
- chomp($hw_model = `write sys\$output f\$getsyi("HW_MODEL")`);
- $Is_VMS_VAX = $hw_model < 1024 ? 1 : 0;
-}
-
-# No %Config.
-my $Is_Ultrix_VAX = $^O eq 'ultrix' && `uname -m` =~ /^VAX$/;
-
while (<DATA>) {
s/^\s*>//; s/<\s*$//;
($template, $data, $result, $comment) = split(/<\s*>/, $_, 4);
@@ -38,7 +28,7 @@ while (<DATA>) {
$data =~ s/([eE])\-101$/${1}-56/; # larger exponents
$result =~ s/([eE])\-102$/${1}-57/; # " "
}
- if ($Is_VMS_VAX || $Is_Ultrix_VAX) {
+ if ($Is{VMS_VAX} || $Is{Ultrix_VAX}) {
# VAX DEC C 5.3 at least since there is no
# ccflags =~ /float=ieee/ on VAX.
# AXP is unaffected whether or not it's using ieee.
diff --git a/t/op/stat.t b/t/op/stat.t
index a225de4..2a831ec 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -11,27 +11,9 @@ use File::Spec;
plan tests => 107;
+$Is{UFS} = $Is{Darwin} && (() = `df -t ufs . 2>/dev/null`) == 2;
my $Perl = which_perl();
-$Is_Amiga = $^O eq 'amigaos';
-$Is_Cygwin = $^O eq 'cygwin';
-$Is_Darwin = $^O eq 'darwin';
-$Is_Dos = $^O eq 'dos';
-$Is_MacOS = $^O eq 'MacOS';
-$Is_MPE = $^O eq 'mpeix';
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$Is_OS2 = $^O eq 'os2';
-$Is_Solaris = $^O eq 'solaris';
-$Is_VMS = $^O eq 'VMS';
-$Is_DGUX = $^O eq 'dgux';
-$Is_MPRAS = $^O =~ /svr4/ && -f '/etc/.relid';
-$Is_Rhapsody= $^O eq 'rhapsody';
-
-$Is_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare || $Is_Cygwin;
-
-$Is_UFS = $Is_Darwin && (() = `df -t ufs . 2>/dev/null`) == 2;
-
my($DEV, $INO, $MODE, $NLINK, $UID, $GID, $RDEV, $SIZE,
$ATIME, $MTIME, $CTIME, $BLKSIZE, $BLOCKS) = (0..12);
@@ -52,7 +34,7 @@ my($nlink, $mtime, $ctime) = (stat(FOO))[$NLINK, $MTIME, $CTIME];
# The clock on a network filesystem might be different from the
# system clock.
-my $Filesystem_Time_Offset = abs($mtime - time);
+my $Filesystem_Time_Offset = abs($mtime - time);
#nlink should if link support configured in Perl.
SKIP: {
@@ -64,7 +46,7 @@ SKIP: {
SKIP: {
skip "mtime and ctime not reliable", 2
- if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos or $Is_MacOS or $Is_Darwin;
+ if $Is{MSWin32} or $Is{NetWare} or $Is{Cygwin} or $Is{Dos} or $Is{MacOS} or $Is{Darwin};
ok( $mtime, 'mtime' );
is( $mtime, $ctime, 'mtime == ctime' );
@@ -72,7 +54,7 @@ SKIP: {
# Cygwin seems to have a 3 second granularity on its timestamps.
-my $funky_FAT_timestamps = $Is_Cygwin;
+my $funky_FAT_timestamps = $Is{Cygwin};
sleep 3 if $funky_FAT_timestamps;
print FOO "Now is the time for all good men to come to.\n";
@@ -103,18 +85,18 @@ SKIP: {
SKIP: {
my $cwd = File::Spec->rel2abs($Curdir);
skip "Solaris tmpfs has different mtime/ctime link semantics", 2
- if $Is_Solaris and $cwd =~ m#^/tmp# and
+ if $Is{Solaris} and $cwd =~ m#^/tmp# and
$mtime && $mtime == $ctime;
skip "AFS has different mtime/ctime link semantics", 2
if $cwd =~ m#$Config{'afsroot'}/#;
skip "AmigaOS has different mtime/ctime link semantics", 2
- if $Is_Amiga;
+ if $Is{Amiga};
# Win32 could pass $mtime test but as FAT and NTFS have
# no ctime concept $ctime is ALWAYS == $mtime
# expect netware to be the same ...
skip "No ctime concept on this OS", 2
- if $Is_MSWin32 ||
- ($Is_Darwin && $Is_UFS);
+ if $Is{MSWin32} ||
+ ($Is{Darwin} && $Is{UFS});
if( !ok($mtime, 'hard link mtime') ||
!isnt($mtime, $ctime, 'hard link ctime != mtime') ) {
@@ -157,7 +139,7 @@ ok(-s $tmpfile, ' and -s');
ok( chmod(0000, $tmpfile), 'chmod 0000' );
SKIP: {
- skip "-r, -w and -x have different meanings on VMS", 3 if $Is_VMS;
+ skip "-r, -w and -x have different meanings on VMS", 3 if $Is{VMS};
SKIP: {
# Going to try to switch away from root. Might not work.
@@ -167,7 +149,7 @@ SKIP: {
if $> == 0;
SKIP: {
- skip "Can't test -r meaningfully?", 1 if $Is_Dos || $Is_Cygwin;
+ skip "Can't test -r meaningfully?", 1 if $Is{Dos} || $Is{Cygwin};
ok(!-r $tmpfile, " -r");
}
@@ -188,7 +170,7 @@ ok(-w $tmpfile, ' -w');
SKIP: {
skip "-x simply determines if a file ends in an executable suffix", 1
- if $Is_Dosish || $Is_MacOS;
+ if $Is{Dosish} || $Is{MacOS};
ok(-x $tmpfile, ' -x');
}
@@ -220,11 +202,11 @@ ok(! -e $tmpfile_link, ' -e on unlinked file');
SKIP: {
skip "No character, socket or block special files", 6
- if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
+ if $Is{MSWin32} || $Is{NetWare} || $Is{Dos};
skip "/dev isn't available to test against", 6
unless -d '/dev' && -r '/dev' && -x '/dev';
skip "Skipping: unexpected ls output in MP-RAS", 6
- if $Is_MPRAS;
+ if $Is{MPRAS};
# VMS problem: If GNV or other UNIX like tool is installed, then
# sometimes Perl will find /bin/ls, and will try to run it.
@@ -234,7 +216,7 @@ SKIP: {
# be run instead. So do not do this until we can teach Perl
# when to use BASH on VMS.
skip "ls command not available to Perl in OpenVMS right now.", 6
- if $Is_VMS;
+ if $Is{VMS};
my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l";
my $CMD = "$LS /dev 2>/dev/null";
@@ -280,7 +262,7 @@ SKIP: {
};
SKIP: {
- skip("DG/UX ls -L broken", 3) if $Is_DGUX;
+ skip("DG/UX ls -L broken", 3) if $Is{DGUX};
$try->('b', '-b');
$try->('c', '-c');
@@ -328,10 +310,10 @@ SKIP: {
SKIP: {
skip "These tests require a TTY", 4 if $ENV{PERL_SKIP_TTY_TEST};
- my $TTY = $Is_Rhapsody ? "/dev/ttyp0" : "/dev/tty";
+ my $TTY = $Is{Rhapsody} ? "/dev/ttyp0" : "/dev/tty";
SKIP: {
- skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare;
+ skip "Test uses unixisms", 2 if $Is{MSWin32} || $Is{NetWare};
skip "No TTY to test -t with", 2 unless -e $TTY;
open(TTY, $TTY) ||
@@ -343,7 +325,7 @@ SKIP: {
ok(! -t TTY, '!-t on closed TTY filehandle');
{
- local $TODO = 'STDIN not a tty when output is to pipe' if $Is_VMS;
+ local $TODO = 'STDIN not a tty when output is to pipe' if $Is{VMS};
ok(-t, '-t on STDIN');
}
}
@@ -351,7 +333,7 @@ SKIP: {
my $Null = File::Spec->devnull;
SKIP: {
skip "No null device to test with", 1 unless -e $Null;
- skip "We know Win32 thinks '$Null' is a TTY", 1 if $Is_MSWin32;
+ skip "We know Win32 thinks '$Null' is a TTY", 1 if $Is{MSWin32};
open(NULL, $Null) or DIE("Can't open $Null: $!");
ok(! -t NULL, 'null device is not a TTY');
@@ -365,7 +347,7 @@ ok( -T $statfile, '-T');
ok(! -B $statfile, '!-B');
SKIP: {
- skip("DG/UX", 1) if $Is_DGUX;
+ skip("DG/UX", 1) if $Is{DGUX};
ok(-B $Perl, '-B');
}
@@ -438,7 +420,7 @@ eval { lstat _ };
is( "$@", "", "lstat _ ok after lstat" );
eval { -l _ };
is( "$@", "", "-l _ ok after lstat" );
-
+
SKIP: {
skip "No lstat", 2 unless $Config{d_lstat};
@@ -491,8 +473,8 @@ SKIP: {
SKIP: {
skip "No dirfd()", 9 unless $Config{d_dirfd} || $Config{d_dir_dd_fd};
ok(opendir(DIR, "."), 'Can open "." dir') || diag "Can't open '.': $!";
- ok(stat(DIR), "stat() on dirhandle works");
- ok(-d -r _ , "chained -x's on dirhandle");
+ ok(stat(DIR), "stat() on dirhandle works");
+ ok(-d -r _ , "chained -x's on dirhandle");
ok(-d DIR, "-d on a dirhandle works");
# And now for the ambigious bareword case
@@ -511,7 +493,7 @@ SKIP: {
# RT #8244: *FILE{IO} does not behave like *FILE for stat() and -X() operators
ok(open(F, ">", $tmpfile), 'can create temp file');
my @thwap = stat *F{IO};
- ok(@thwap, "stat(*F{IO}) works");
+ ok(@thwap, "stat(*F{IO}) works");
ok( -f *F{IO} , "single file tests work with *F{IO}");
close F;
unlink $tmpfile;
@@ -522,7 +504,7 @@ SKIP: {
skip "No dirfd()", 9 unless $Config{d_dirfd} || $Config{d_dir_dd_fd};
ok(opendir(DIR, "."), 'Can open "." dir') || diag "Can't open '.': $!";
ok(stat(*DIR{IO}), "stat() on *DIR{IO} works");
- ok(-d _ , "The special file handle _ is set correctly");
+ ok(-d _ , "The special file handle _ is set correctly");
ok(-d -r *DIR{IO} , "chained -x's on *DIR{IO}");
# And now for the ambigious bareword case
diff --git a/t/op/taint.t b/t/op/taint.t
index 01ab368..b06897d 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -15,6 +15,7 @@ BEGIN {
use strict;
use Config;
use File::Spec::Functions;
+use vars '%Is';
BEGIN { require './test.pl'; }
plan tests => 298;
@@ -42,21 +43,14 @@ BEGIN {
}
}
-my $Is_MacOS = $^O eq 'MacOS';
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $Is_NetWare = $^O eq 'NetWare';
-my $Is_Dos = $^O eq 'dos';
-my $Is_Cygwin = $^O eq 'cygwin';
-my $Is_OpenBSD = $^O eq 'openbsd';
-my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.exe' :
- $Is_MSWin32 ? '.\perl' :
- $Is_MacOS ? ':perl' :
- $Is_NetWare ? 'perl' :
+my $Invoke_Perl = $Is{VMS} ? 'MCR Sys$Disk:[]Perl.exe' :
+ $Is{MSWin32} ? '.\perl' :
+ $Is{MacOS} ? ':perl' :
+ $Is{NetWare} ? 'perl' :
'./perl' ;
my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
-if ($Is_VMS) {
+if ($Is{VMS}) {
my (%old, $x);
for $x ('DCL$PATH', @MoreEnv) {
($old{$x}) = $ENV{$x} =~ /^(.*)$/ if exists $ENV{$x};
@@ -134,7 +128,7 @@ sub test ($;$) {
}
# We need an external program to call.
-my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : $Is_MacOS ? ":echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
+my $ECHO = ($Is{MSWin32} ? ".\\echo$$" : $Is{MacOS} ? ":echo$$" : ($Is{NetWare} ? "echo$$" : "./echo$$"));
END { unlink $ECHO }
open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
print PROG 'print "@ARGV\n"', "\n";
@@ -147,9 +141,9 @@ my $TEST = catfile(curdir(), 'TEST');
# environment variables. Maybe they aren't set yet, so we'll
# taint them ourselves.
{
- $ENV{'DCL$PATH'} = '' if $Is_VMS;
+ $ENV{'DCL$PATH'} = '' if $Is{VMS};
- if ($Is_MSWin32 && $Config{ccname} =~ /bcc32/ && ! -f 'cc3250mt.dll') {
+ if ($Is{MSWin32} && $Config{ccname} =~ /bcc32/ && ! -f 'cc3250mt.dll') {
my $bcc_dir;
foreach my $dir (split /$Config{path_sep}/, $ENV{PATH}) {
if (-f "$dir/cc3250mt.dll") {
@@ -165,7 +159,7 @@ my $TEST = catfile(curdir(), 'TEST');
};
}
}
- $ENV{PATH} = ($Is_Cygwin) ? '/usr/bin' : '';
+ $ENV{PATH} = ($Is{Cygwin}) ? '/usr/bin' : '';
delete @ENV{@MoreEnv};
$ENV{TERM} = 'dumb';
@@ -173,7 +167,7 @@ my $TEST = catfile(curdir(), 'TEST');
SKIP: {
skip "Environment tainting tests skipped", 4
- if $Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos || $Is_MacOS;
+ if $Is{MSWin32} || $Is{NetWare} || $Is{VMS} || $Is{Dos} || $Is{MacOS};
my @vars = ('PATH', @MoreEnv);
while (my $v = $vars[0]) {
@@ -194,7 +188,7 @@ my $TEST = catfile(curdir(), 'TEST');
}
my $tmp;
- if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_NetWare || $Is_Dos) {
+ if ($^O eq 'os2' || $^O eq 'amigaos' || $Is{MSWin32} || $Is{NetWare} || $Is{Dos}) {
print "# all directories are writeable\n";
}
else {
@@ -213,7 +207,7 @@ my $TEST = catfile(curdir(), 'TEST');
}
SKIP: {
- skip "This is not VMS", 4 unless $Is_VMS;
+ skip "This is not VMS", 4 unless $Is{VMS};
$ENV{'DCL$PATH'} = $TAINT;
test eval { `$echo 1` } eq '';
@@ -314,7 +308,7 @@ SKIP: {
# Globs should be forbidden, except under VMS,
# which doesn't spawn an external program.
SKIP: {
- skip "globs should be forbidden", 2 if 1 or $Is_VMS;
+ skip "globs should be forbidden", 2 if 1 or $Is{VMS};
my @globs = eval { <*> };
test @globs == 0 && $@ =~ /^Insecure dependency/;
@@ -430,7 +424,7 @@ SKIP: {
# just because Errno possibly failing.
test eval('$!{ENOENT}') ||
$! == 2 || # File not found
- ($Is_Dos && $! == 22) ||
+ ($Is{Dos} && $! == 22) ||
($^O eq 'mint' && $! == 33);
test !eval { open FOO, "> $foo" }, 'open for write';
@@ -465,8 +459,8 @@ SKIP: {
SKIP: {
# wildcard expansion doesn't invoke shell on VMS, so is safe
- skip "This is not VMS", 2 unless $Is_VMS;
-
+ skip "This is not VMS", 2 unless $Is{VMS};
+
test join('', eval { glob $foo } ) ne '', 'globbing';
test $@ eq '', $@;
}
@@ -591,7 +585,7 @@ SKIP: {
{
# No reliable %Config check for getpw*
SKIP: {
- skip "getpwent() is not available", 1 unless
+ skip "getpwent() is not available", 1 unless
eval { setpwent(); getpwent() };
setpwent();
@@ -621,14 +615,14 @@ SKIP: {
}
SKIP: {
- skip "readlink() or symlink() is not available" unless
+ skip "readlink() or symlink() is not available" unless
$Config{d_readlink} && $Config{d_symlink};
my $symlink = "sl$$";
unlink($symlink);
my $sl = "/something/naughty";
# it has to be a real path on Mac OS
- $sl = MacPerl::MakePath((MacPerl::Volumes())[0]) if $Is_MacOS;
+ $sl = MacPerl::MakePath((MacPerl::Volumes())[0]) if $Is{MacOS};
symlink($sl, $symlink) or die "symlink: $!\n";
my $readlink = readlink($symlink);
test tainted $readlink;
@@ -689,7 +683,7 @@ SKIP: {
warn "# shmget failed: $!\n";
}
- skip "SysV shared memory operation failed", 1 unless
+ skip "SysV shared memory operation failed", 1 unless
$rcvd eq $sent;
test tainted $rcvd;
@@ -790,25 +784,25 @@ SKIP: {
eval { sysopen(my $ro, $evil, &O_RDONLY) };
test $@ !~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $wo, $evil, &O_WRONLY) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $rw, $evil, &O_RDWR) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $ap, $evil, &O_APPEND) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $cr, $evil, &O_CREAT) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $tr, $evil, &O_TRUNC) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $ro, "foo", &O_RDONLY | $TAINT0) };
test $@ !~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $wo, "foo", &O_WRONLY | $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
@@ -817,7 +811,7 @@ SKIP: {
eval { sysopen(my $ap, "foo", &O_APPEND | $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $cr, "foo", &O_CREAT | $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
@@ -826,22 +820,22 @@ SKIP: {
eval { sysopen(my $ro, "foo", &O_RDONLY, $TAINT0) };
test $@ !~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $wo, "foo", &O_WRONLY, $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $rw, "foo", &O_RDWR, $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $ap, "foo", &O_APPEND, $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
-
+
eval { sysopen(my $cr, "foo", &O_CREAT, $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
eval { sysopen(my $tr, "foo", &O_TRUNC, $TAINT0) };
test $@ =~ /^Insecure dependency/, $@;
-
+
unlink("foo"); # not unlink($evil), because that would fail...
}
}
@@ -884,9 +878,9 @@ SKIP: {
${$_ [0]}
}
-
+
package main;
-
+
my $bar = "The Big Bright Green Pleasure Machine";
taint_these $bar;
tie my ($foo), Tie => $bar;
@@ -919,19 +913,19 @@ ok( $@ =~ /^Modification of a read-only value attempted/,
{
# bug 20011111.105
-
+
my $re1 = qr/x$TAINT/;
test tainted $re1;
-
+
my $re2 = qr/^$re1\z/;
test tainted $re2;
-
+
my $re3 = "$re2";
test tainted $re3;
}
SKIP: {
- skip "system {} has different semantics on Win32", 1 if $Is_MSWin32;
+ skip "system {} has different semantics on Win32", 1 if $Is{MSWin32};
# bug 20010221.005
local $ENV{PATH} .= $TAINT;
@@ -941,7 +935,7 @@ SKIP: {
TODO: {
todo_skip 'tainted %ENV warning occludes tainted arguments warning', 22
- if $Is_VMS;
+ if $Is{VMS};
# bug 20020208.005 plus some single arg exec/system extras
my $err = qr/^Insecure dependency/ ;
@@ -967,18 +961,18 @@ TODO: {
test !eval { system {'notaint'} $TAINT }, 'system';
test $@ =~ $err, $@;
- eval {
+ eval {
no warnings;
- system("lskdfj does not exist","with","args");
+ system("lskdfj does not exist","with","args");
};
test !$@;
SKIP: {
- skip "no exec() on MacOS Classic" if $Is_MacOS;
+ skip "no exec() on MacOS Classic" if $Is{MacOS};
- eval {
+ eval {
no warnings;
- exec("lskdfj does not exist","with","args");
+ exec("lskdfj does not exist","with","args");
};
test !$@;
}
@@ -1161,7 +1155,7 @@ SKIP:
SKIP: {
skip "fork() is not available", 3 unless $Config{'d_fork'};
skip "opening |- is not stable on threaded OpenBSD with taint", 3
- if $Config{useithreads} && $Is_OpenBSD;
+ if $Config{useithreads} && $Is{OpenBSD};
$ENV{'PATH'} = $TAINT;
local $SIG{'PIPE'} = 'IGNORE';
diff --git a/t/op/tr.t b/t/op/tr.t
index 9273e09..136a7ee 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -8,8 +8,6 @@ BEGIN {
plan tests => 118;
-my $Is_EBCDIC = (ord('i') == 0x89 & ord('J') == 0xd1);
-
$_ = "abcdefghijklmnopqrstuvwxyz";
tr/a-z/A-Z/;
@@ -95,7 +93,7 @@ else {
my $l = chr(300); my $r = chr(400);
$x = 200.300.400;
$x =~ tr/\x{12c}/\x{190}/;
- is($x, 200.400.400,
+ is($x, 200.400.400,
'changing UTF8 chars in a UTF8 string, same length');
is(length $x, 3);
@@ -273,7 +271,7 @@ is($a, "X");
($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
is($a, "X");
-
+
($a = v256) =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
is($a, "X");
@@ -300,12 +298,12 @@ is($c, 8);
is($a, "XXXXXXXX");
SKIP: {
- skip "not EBCDIC", 4 unless $Is_EBCDIC;
+ skip "not EBCDIC", 4 unless $Is{EBCDIC};
$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
is($c, 2);
is($a, "X\x8a\x8b\x8c\x8d\x8f\x90X");
-
+
$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
is($c, 2);
is($a, "X\xca\xcb\xcc\xcd\xcf\xd0X");
diff --git a/t/op/vec.t b/t/op/vec.t
index aed1d0f..6bf6acc 100755
--- a/t/op/vec.t
+++ b/t/op/vec.t
@@ -8,8 +8,6 @@ BEGIN {
require "test.pl";
plan( tests => 31 );
-my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
-
is(vec($foo,0,1), 0);
is(length($foo), undef);
vec($foo,0,1) = 1;
@@ -68,8 +66,8 @@ ok(! $@);
$@ = undef;
eval { vec($foo, 1, 8) = 13 };
ok(! $@);
-if ($Is_EBCDIC) {
- is($foo, "\x8c\x0d\xff\x8a\x69");
+if ($Is{EBCDIC}) {
+ is($foo, "\x8c\x0d\xff\x8a\x69");
}
else {
is($foo, "\xc4\x0d\xc3\xbf\xc3\xbe");
@@ -93,5 +91,5 @@ is($foo, "\x61\x62\x63\x34\x65\x66");
vec($s, 1, 1) = 1;
my @r;
$r[$_] = \ vec $s, $_, 1 for (0, 1);
- ok(!(${ $r[0] } != 0 || ${ $r[1] } != 1));
+ ok(!(${ $r[0] } != 0 || ${ $r[1] } != 1));
}
diff --git a/t/run/cloexec.t b/t/run/cloexec.t
index dfbae3a..74bb841 100644
--- a/t/run/cloexec.t
+++ b/t/run/cloexec.t
@@ -44,17 +44,14 @@ BEGIN {
}
use strict;
+use vars '%Is';
$|=1;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-my $Is_Win32 = $^O eq 'MSWin32';
-
# When in doubt, skip.
-skip_all("MacOS") if $Is_MacOS;
-skip_all("VMS") if $Is_VMS;
-skip_all("Win32") if $Is_Win32;
+skip_all("MacOS") if $Is{MacOS};
+skip_all("VMS") if $Is{VMS};
+skip_all("Win32") if $Is{Win32};
sub make_tmp_file {
my ($fname, $fcontents) = @_;
@@ -65,7 +62,7 @@ sub make_tmp_file {
}
my $Perl = which_perl();
-my $quote = $Is_VMS || $Is_Win32 ? '"' : "'";
+my $quote = $Is{VMS} || $Is{Win32} ? '"' : "'";
my $tmperr = tempfile();
my $tmpfile1 = tempfile();
diff --git a/t/run/switchI.t b/t/run/switchI.t
index 398f816..80a37e1 100644
--- a/t/run/switchI.t
+++ b/t/run/switchI.t
@@ -10,24 +10,22 @@ BEGIN {
plan(4);
}
-my $Is_MacOS = $^O eq 'MacOS';
-my $Is_VMS = $^O eq 'VMS';
my $lib;
-$lib = $Is_MacOS ? ':Bla:' : 'Bla';
+$lib = $Is{MacOS} ? ':Bla:' : 'Bla';
ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
SKIP: {
- skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
- $lib = $Is_MacOS ? 'Foo::Bar:' : 'Foo::Bar';
+ skip 'Double colons not allowed in dir spec', 1 if $Is{VMS};
+ $lib = $Is{MacOS} ? 'Foo::Bar:' : 'Foo::Bar';
ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
}
-$lib = $Is_MacOS ? ':Bla2:' : 'Bla2';
+$lib = $Is{MacOS} ? ':Bla2:' : 'Bla2';
fresh_perl_is("print grep { \$_ eq '$lib' } \@INC[0..(\$#INC-1)]", $lib,
{ switches => ['-IBla2'] }, '-I');
SKIP: {
- skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
- $lib = $Is_MacOS ? 'Foo::Bar2:' : 'Foo::Bar2';
+ skip 'Double colons not allowed in dir spec', 1 if $Is{VMS};
+ $lib = $Is{MacOS} ? 'Foo::Bar2:' : 'Foo::Bar2';
fresh_perl_is("print grep { \$_ eq '$lib' } \@INC", $lib,
{ switches => ['-IFoo::Bar2'] }, '-I with colons');
}
diff --git a/t/test.pl b/t/test.pl
index 32c4a37..9df254d 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -25,6 +25,46 @@ my $Perl; # Safer version of $^X set by which_perl()
$TODO = 0;
$NO_ENDING = 0;
+# XXX: which is right?
+# $Is{EBCDIC} = (defined $Config{ebcdic} && $Config{ebcdic} eq 'define');
+# $Is{EBCDIC} = (ord('i') == 0x89 & ord('J') == 0xd1);
+$Is{EBCDIC} = (ord('A') == 193) ? 1 : 0;
+$Is{UTF8} = (${^OPEN} || "") =~ /:utf8/;
+
+$Is{Amiga} = $^O eq 'amigaos';
+$Is{BeOS} = $^O eq 'beos';
+$Is{Cygwin} = $^O eq 'cygwin';
+$Is{DGUX} = $^O eq 'dgux';
+$Is{Darwin} = $^O eq 'darwin';
+# $Is{Dosish} = $Is{Dos} || $Is{OS2} || $Is{MSWin32} || $Is{NetWare} || $Is{Cygwin};
+$Is{Dosish} = ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'dos' or $^O eq 'os2' or $^O eq 'mint' or $^O eq 'cygwin' or $^O =~ /^uwin/);
+$Is{Dos} = $^O eq 'dos';
+$Is{MPE} = $^O eq 'mpeix';
+$Is{MPRAS} = $^O =~ /svr4/ && -f '/etc/.relid';
+$Is{MSWin32} = $^O eq 'MSWin32';
+$Is{MacOS} = $^O eq 'MacOS';
+$Is{NetWare} = $^O eq 'NetWare';
+$Is{OS2} = $^O eq 'os2';
+$Is{OS390} = $^O eq 'os390';
+$Is{Rhapsody}= $^O eq 'rhapsody';
+$Is{Solaris} = $^O eq 'solaris';
+$Is{UWin} = $^O eq 'uwin';
+$Is{VMS} = $^O eq 'VMS';
+$Is{W32} = $^O eq 'MSWin32';
+$Is{os2} = $^O eq 'os2';
+
+$Is{miniperl} = $ENV{PERL_CORE_MINITEST};
+
+$Is{VMS_VAX} = 0;
+# We use HW_MODEL since ARCH_NAME was not in VMS V5.*
+if ($^O eq 'VMS') {
+ my $hw_model;
+ chomp($hw_model = `write sys\$output f\$getsyi("HW_MODEL")`);
+ $Is{VMS_VAX} = $hw_model < 1024 ? 1 : 0;
+}
+# No %Config.
+$Is{Ultrix_VAX} = $^O eq 'ultrix' && `uname -m` =~ /^VAX$/;
+
# Use this instead of print to avoid interference while testing globals.
sub _print {
local($\, $", $,) = (undef, ' ', '');
Thread Next
-
Remove duplication of test setup.
by Sean O'Rourke