chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
- plan (tests => 187);
+ plan (tests => 192);
}
# Test that defined() returns true for magic variables created on the fly,
# avoid using any global vars here:
if ($v =~ s/^\^(?=.)//) {
for(substr $v, 0, 1) {
- $_ = chr ord() - 64;
+ $_ = chr(utf8::native_to_unicode(ord($_)) - 64);
}
}
SKIP:
$eqv = "\n" if length($eqv) == 2 and $eqv eq "\000\n";
is $eqv, "$val\n", $desc;
} else {
- chomp (my @env = grep { s/^$key=// } `env`);
- is "@env", $val, $desc;
+ my @env = `env`;
+ SKIP: {
+ skip("env doesn't work on this android", 1) if !@env && $^O =~ /android/;
+ chomp (my @env = grep { s/^$key=// } @env);
+ is "@env", $val, $desc;
+ }
}
}
sub FETCH { $next_test + pop }
tie my @tn, __PACKAGE__;
- open( CMDPIPE, "| $PERL");
+ open( CMDPIPE, "|-", $PERL);
print CMDPIPE "\$t1 = $tn[1]; \$t2 = $tn[2];\n", <<'END';
close CMDPIPE;
- open( CMDPIPE, "| $PERL");
+ open( CMDPIPE, "|-", $PERL);
print CMDPIPE "\$t3 = $tn[3];\n", <<'END';
{ package X;
close CMDPIPE;
$? >>= 8 if $^O eq 'VMS'; # POSIX status hiding in 2nd byte
my $todo = ($^O eq 'os2' ? ' # TODO: EMX v0.9d_fix4 bug: wrong nibble? ' : '');
+ $todo = ($Config{usecrosscompile} ? '# TODO: Not sure whats going on here when cross-compiling' : '');
print $? & 0xFF ? "ok $tn[4]$todo\n" : "not ok $tn[4]$todo\n";
- open(CMDPIPE, "| $PERL");
+ open(CMDPIPE, "|-", $PERL);
print CMDPIPE <<'END';
sub PVBM () { 'foo' }
if ($^O eq 'qnx') {
chomp($wd = `/usr/bin/fullpath -t`);
}
+ elsif($^O =~ /android/) {
+ chomp($wd = `sh -c 'pwd'`);
+ }
elsif($Is_Cygwin || $is_abs) {
# Cygwin turns the symlink into the real file
chomp($wd = `pwd`);
# argv[0] assignment and by calling prctl()
{
SKIP: {
- skip "We don't have prctl() here", 2 unless $Config{d_prctl_set_name};
+ skip "We don't have prctl() here, or we're on Android", 2 unless $Config{d_prctl_set_name} && $^O ne 'android';
# We don't really need these tests. prctl() is tested in the
# Kernel, but test it anyway for our sanity. If something doesn't
chomp(my $argv0 = $maybe_ps->("ps h $$"));
chomp(my $prctl = $maybe_ps->("ps hc $$"));
- like($argv0, $name, "Set process name through argv[0] ($argv0)");
- like($prctl, substr($name, 0, 15), "Set process name through prctl() ($prctl)");
+ like($argv0, qr/$name/, "Set process name through argv[0] ($argv0)");
+ my $name_substr = substr($name, 0, 15);
+ like($prctl, qr/$name_substr/, "Set process name through prctl() ($prctl)");
}
}
undef %Errno::;
delete $INC{"Errno.pm"};
+ delete $::{"!"};
open(FOO, "nonesuch"); # Generate ENOENT
my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
# This one used to croak due to that missing break:
is ++${^MPEN}, 1, '${^MPEN} can be incremented';
+{
+ no warnings 'deprecated';
+ eval { ${^E_NCODING} = 1 };
+ is $@, "", 'Setting ${^E_NCODING} does nothing';
+ $_ = ${^E_NCODING};
+ pass('can read ${^E_NCODING} without blowing up');
+ is $_, 1, '${^E_NCODING} is whatever it was set to';
+}
+
+{
+ my $warned = 0;
+ local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; };
+ unshift @RT12608::A::ISA, qw(RT12608::B RT12608::C);
+ is $warned, 0, '[perl #126082] unshifting onto @ISA doesn\'t trigger set magic for each item';
+}
+
+{
+ my $warned = 0;
+ local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; };
+
+ my $x; tie $x, 'RT12608::F';
+ unshift @RT12608::X::ISA, $x, "RT12608::Z";
+ is $warned, 0, '[perl #126082] PL_delaymagic correctly/saved restored when pushing/unshifting onto @ISA';
+
+ package RT12608::F;
+ use parent 'Tie::Scalar';
+ sub TIESCALAR { bless {}; }
+ sub FETCH { push @RT12608::G::ISA, "RT12608::H"; "RT12608::Y"; }
+}
+
# ^^^^^^^^^ New tests go here ^^^^^^^^^
SKIP: {
- skip("%ENV manipulations fail or aren't safe on $^O", 19)
+ skip("%ENV manipulations fail or aren't safe on $^O", 20)
if $Is_Dos;
+ skip "Win32 needs XS for env/shell tests", 20
+ if $Is_MSWin32 && is_miniperl;
SKIP: {
skip("clearing \%ENV is not safe when running under valgrind or on VMS")
SKIP: {
skip("\$0 check only on Linux and FreeBSD", 2)
- unless $^O =~ /^(linux|freebsd)$/
+ unless $^O =~ /^(linux|android|freebsd)$/
&& open CMDLINE, "/proc/$$/cmdline";
chomp(my $line = scalar <CMDLINE>);
my $me = (split /\0/, $line)[0];
is $me, $0, 'altering $0 is effective (testing with /proc/)';
close CMDLINE;
+ skip("\$0 check with 'ps' only on Linux (but not Android) and FreeBSD", 1) if $^O eq 'android';
# perlbug #22811
my $mydollarzero = sub {
my($arg) = shift;