summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2002-05-07 07:07:58 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2002-05-07 07:07:58 +0000
commit105361ce16bc636fe517601463fa5644019149c4 (patch)
tree0fef968d06962d3698e81cc3bd5cb825e7e09bcf /t
parent901ecf3430b96ad57e07dea513e1e92aee530988 (diff)
parentbe61827f32f7b49ea321451b189a9235d1190874 (diff)
downloadperl-105361ce16bc636fe517601463fa5644019149c4.tar.gz
Integrate mainline
p4raw-id: //depot/perlio@16440
Diffstat (limited to 't')
-rwxr-xr-xt/io/fs.t4
-rwxr-xr-xt/op/arith.t12
-rwxr-xr-xt/op/exec.t8
-rwxr-xr-xt/op/local.t16
-rwxr-xr-xt/op/pwent.t12
-rwxr-xr-xt/op/tie.t9
6 files changed, 51 insertions, 10 deletions
diff --git a/t/io/fs.t b/t/io/fs.t
index 12eec19283..7535e4ebfd 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -271,7 +271,7 @@ SKIP: {
# Check truncating a closed file.
eval { truncate "Iofs.tmp", 5; };
- skip("no truncate - $@", 10) if $@;
+ skip("no truncate - $@", 6) if $@;
is(-s "Iofs.tmp", 5, "truncation to five bytes");
@@ -304,7 +304,7 @@ SKIP: {
}
if ($^O eq 'vos') {
- skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 7);
+ skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 3);
}
is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)");
diff --git a/t/op/arith.t b/t/op/arith.t
index 55a5e48084..654ce3b857 100755
--- a/t/op/arith.t
+++ b/t/op/arith.t
@@ -22,7 +22,7 @@ sub tryeq_sloppy ($$$) {
print "ok $_[0]\n";
} else {
my $error = abs ($_[1] - $_[2]) / $_[1];
- if ($error < 1e-10) {
+ if ($error < 1e-9) {
print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O\n";
} else {
print "not ok $_[0] # $_[1] != $_[2]\n";
@@ -242,7 +242,7 @@ tryeq 120, -0x80000000/1, -0x80000000;
tryeq 121, -0x80000000/-1, 0x80000000;
# The example for sloppy divide, rigged to avoid the peephole optimiser.
-tryeq 122, "20." / "5.", 4;
+tryeq_sloppy 122, "20." / "5.", 4;
tryeq 123, 2.5 / 2, 1.25;
tryeq 124, 3.5 / -2, -1.75;
@@ -252,9 +252,9 @@ tryeq 126, -5.5 / -2, 2.75;
# Bluuurg if your floating point can't accurately cope with powers of 2
# [I suspect this is parsing string->float problems, not actual arith]
tryeq_sloppy 127, 18446744073709551616/1, 18446744073709551616; # Bluuurg
-tryeq 128, 18446744073709551616/2, 9223372036854775808;
-tryeq 129, 18446744073709551616/4294967296, 4294967296;
-tryeq 130, 18446744073709551616/9223372036854775808, 2;
+tryeq_sloppy 128, 18446744073709551616/2, 9223372036854775808;
+tryeq_sloppy 129, 18446744073709551616/4294967296, 4294967296;
+tryeq_sloppy 130, 18446744073709551616/9223372036854775808, 2;
{
# The peephole optimiser is wrong to think that it can substitute intops
@@ -263,7 +263,7 @@ tryeq 130, 18446744073709551616/9223372036854775808, 2;
my $n = 1127;
my $float = ($n % 1000) * 167772160.0;
- tryeq 131, $float, 21307064320;
+ tryeq_sloppy 131, $float, 21307064320;
# On a 32 bit machine, if the i_multiply op is used, you will probably get
# -167772160. It's actually undefined behaviour, so anything may happen.
diff --git a/t/op/exec.t b/t/op/exec.t
index 3edbc6ac62..5f110be32e 100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -19,7 +19,7 @@ my $Is_Win32 = $^O eq 'MSWin32';
skip_all("Tests mostly usesless on MacOS") if $^O eq 'MacOS';
-plan(tests => 20);
+plan(tests => 21);
my $Perl = which_perl();
@@ -74,6 +74,12 @@ is( $echo_out, "ok\n", 'piped echo emulation');
is( scalar `$Perl -le "print 'ok'" | $Perl -e "print <STDIN>"`,
"ok\n", 'extra newlines on outgoing pipes');
+
+ {
+ local($/) = \2;
+ $out = runperl(prog => 'print q{1234}');
+ is($out, "1234", 'ignore $/ when capturing output in scalar context');
+ }
}
diff --git a/t/op/local.t b/t/op/local.t
index 9f977b2cd4..6da03912e9 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..71\n";
+print "1..75\n";
sub foo {
local($a, $b) = @_;
@@ -130,6 +130,7 @@ print +(!defined $a[0]) ? "" : "not ", "ok 41\n";
sub TIEHASH { bless {}, $_[0] }
sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] }
sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v }
+ sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->{$_[1]}; }
sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; }
sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); }
}
@@ -141,6 +142,8 @@ tie %h, 'TH';
{
local($h{'a'}) = 'foo';
local($h{'b'}) = $h{'b'};
+ local($h{'y'});
+ local($h{'z'}) = 33;
print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n";
print +($h{'b'} == 2) ? "" : "not ", "ok 43\n";
local($h{'c'});
@@ -182,6 +185,8 @@ $ENV{_X_} = 'a';
$ENV{_Y_} = 'b';
$ENV{_Z_} = 'c';
{
+ local($ENV{_A_});
+ local($ENV{_B_}) = 'foo';
local($ENV{_X_}) = 'foo';
local($ENV{_Y_}) = $ENV{_Y_};
print +($ENV{_X_} eq 'foo') ? "" : "not ", "ok 54\n";
@@ -243,3 +248,12 @@ while (/(o.+?),/gc) {
print "not " if exists $x{c};
print "ok 71\n";
}
+
+# these tests should be physically located after tests 46 and 58,
+# but are here instead to avoid renumbering everything.
+
+# local() should preserve the existenceness of tied hashes and %ENV
+print "not " if exists $h{'y'}; print "ok 72\n";
+print "not " if exists $h{'z'}; print "ok 73\n";
+print "not " if exists $ENV{_A_}; print "ok 74\n";
+print "not " if exists $ENV{_B_}; print "ok 75\n";
diff --git a/t/op/pwent.t b/t/op/pwent.t
index fc71f574ad..4d9de4490f 100755
--- a/t/op/pwent.t
+++ b/t/op/pwent.t
@@ -49,6 +49,18 @@ BEGIN {
}
}
+ if (not defined $where) { # Try NIS+
+ foreach my $niscat (qw(/bin/niscat)) {
+ if (-x $niscat &&
+ open(PW, "$niscat passwd.org_dir 2>/dev/null |") &&
+ defined(<PW>)) {
+ $where = "NIS+ $niscat passwd.org_dir";
+ undef $reason;
+ last;
+ }
+ }
+ }
+
if ($reason) { # Give up.
print "1..0 # Skip: $reason\n";
exit 0;
diff --git a/t/op/tie.t b/t/op/tie.t
index 9a651555fc..f8f2322632 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -202,3 +202,12 @@ EXPECT
tie FH, 'main';
EXPECT
+########
+# correct unlocalisation of tied hashes (patch #16431)
+use Tie::Hash ;
+tie %tied, Tie::StdHash;
+{ local $hash{'foo'} } print "exist1\n" if exists $hash{'foo'};
+{ local $tied{'foo'} } print "exist2\n" if exists $tied{'foo'};
+{ local $ENV{'foo'} } print "exist3\n" if exists $ENV{'foo'};
+EXPECT
+