summaryrefslogtreecommitdiff
path: root/t/op
diff options
context:
space:
mode:
Diffstat (limited to 't/op')
-rwxr-xr-xt/op/auto.t6
-rwxr-xr-xt/op/bop.t21
-rwxr-xr-xt/op/defins.t1
-rwxr-xr-xt/op/die_exit.t9
-rwxr-xr-xt/op/each.t3
-rwxr-xr-xt/op/exec.t7
-rwxr-xr-xt/op/magic.t6
-rwxr-xr-xt/op/misc.t1
-rwxr-xr-xt/op/ord.t8
-rwxr-xr-xt/op/pack.t53
-rwxr-xr-xt/op/quotemeta.t26
-rw-r--r--t/op/re_tests8
-rwxr-xr-xt/op/regexp.t7
-rwxr-xr-xt/op/sort.t37
-rwxr-xr-xt/op/sprintf.t2
-rwxr-xr-xt/op/stat.t29
-rwxr-xr-xt/op/subst.t22
-rwxr-xr-xt/op/taint.t8
-rwxr-xr-xt/op/universal.t12
19 files changed, 204 insertions, 62 deletions
diff --git a/t/op/auto.t b/t/op/auto.t
index 93a42f8472..2eb0097650 100755
--- a/t/op/auto.t
+++ b/t/op/auto.t
@@ -2,7 +2,7 @@
# $RCSfile: auto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:39 $
-print "1..34\n";
+print "1..37\n";
$x = 10000;
if (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
@@ -46,3 +46,7 @@ if (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
if (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
if (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
if (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
+if (++($foo = 'A99') eq 'B00') {print "ok 35\n";} else {print "not ok 35\n";}
+# EBCDIC guards: i and j, r and s, are not contiguous.
+if (++($foo = 'zi') eq 'zj') {print "ok 36\n";} else {print "not ok 36\n";}
+if (++($foo = 'zr') eq 'zs') {print "ok 37\n";} else {print "not ok 37\n";}
diff --git a/t/op/bop.t b/t/op/bop.t
index 0c55029b93..b247341417 100755
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -42,14 +42,23 @@ print ((($cusp >> 1) == ($cusp / 2) &&
do { use integer; $cusp >> 1 } == -($cusp / 2))
? "ok 12\n" : "not ok 12\n");
+$Aaz = chr(ord("A") & ord("z"));
+$Aoz = chr(ord("A") | ord("z"));
+$Axz = chr(ord("A") ^ ord("z"));
+
# short strings
-print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 13\n" : "not ok 13\n");
-print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 14\n" : "not ok 14\n");
-print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 15\n" : "not ok 15\n");
+print (("AAAAA" & "zzzzz") eq ($Aaz x 5) ? "ok 13\n" : "not ok 13\n");
+print (("AAAAA" | "zzzzz") eq ($Aoz x 5) ? "ok 14\n" : "not ok 14\n");
+print (("AAAAA" ^ "zzzzz") eq ($Axz x 5) ? "ok 15\n" : "not ok 15\n");
# long strings
$foo = "A" x 150;
$bar = "z" x 75;
-print (($foo & $bar) eq ('@'x75 ) ? "ok 16\n" : "not ok 16\n");
-print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 17\n" : "not ok 17\n");
-print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 18\n" : "not ok 18\n");
+$zap = "A" x 75;
+# & truncates
+print (($foo & $bar) eq ($Aaz x 75 ) ? "ok 16\n" : "not ok 16\n");
+# | does not truncate
+print (($foo | $bar) eq ($Aoz x 75 . $zap) ? "ok 17\n" : "not ok 17\n");
+# ^ does not truncate
+print (($foo ^ $bar) eq ($Axz x 75 . $zap) ? "ok 18\n" : "not ok 18\n");
+
diff --git a/t/op/defins.t b/t/op/defins.t
index 0ed61ce2fb..33c74ea28e 100755
--- a/t/op/defins.t
+++ b/t/op/defins.t
@@ -61,6 +61,7 @@ while ($where{$seen} = <FILE>)
}
print "not " unless $seen;
print "ok 5\n";
+close FILE;
opendir(DIR,'.');
$seen = 0;
diff --git a/t/op/die_exit.t b/t/op/die_exit.t
index b5760d6fa0..ffbb1e015e 100755
--- a/t/op/die_exit.t
+++ b/t/op/die_exit.t
@@ -30,6 +30,8 @@ my %tests = (
14 => [ 255, 0],
15 => [ 255, 1],
16 => [ 255, 256],
+ # see if implicit close preserves $?
+ 17 => [ 42, 42, '{ local *F; open F, q[TEST]; close F } die;'],
);
my $max = keys %tests;
@@ -37,11 +39,12 @@ my $max = keys %tests;
print "1..$max\n";
foreach my $test (1 .. $max) {
- my($bang, $query) = @{$tests{$test}};
+ my($bang, $query, $code) = @{$tests{$test}};
+ $code ||= 'die;';
my $exit =
($^O eq 'MSWin32'
- ? system qq($perl -e "\$! = $bang; \$? = $query; die;" 2> nul)
- : system qq($perl -e '\$! = $bang; \$? = $query; die;' 2> /dev/null));
+ ? system qq($perl -e "\$! = $bang; \$? = $query; $code" 2> nul)
+ : system qq($perl -e '\$! = $bang; \$? = $query; $code' 2> /dev/null));
printf "# 0x%04x 0x%04x 0x%04x\nnot ", $exit, $bang, $query
unless $exit == (($bang || ($query >> 8) || 255) << 8);
diff --git a/t/op/each.t b/t/op/each.t
index 420fdc09c3..9063c2c3ed 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -43,7 +43,8 @@ if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
$i = 0; # stop -w complaints
while (($key,$value) = each(%h)) {
- if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+ if ($key eq $keys[$i] && $value eq $values[$i]
+ && (('a' lt 'A' && $key lt $value) || $key gt $value)) {
$key =~ y/a-z/A-Z/;
$i++ if $key eq $value;
}
diff --git a/t/op/exec.t b/t/op/exec.t
index 506fc09fbd..098a455455 100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -13,7 +13,12 @@ if ($^O eq 'MSWin32') {
print "1..8\n";
-print "not ok 1\n" if system "echo ok \\1"; # shell interpreted
+if ($^O ne 'os2') {
+ print "not ok 1\n" if system "echo ok \\1"; # shell interpreted
+}
+else {
+ print "ok 1 # skipped: bug/feature of pdksh\n"; # shell interpreted
+}
print "not ok 2\n" if system "echo ok 2"; # split and directly called
print "not ok 3\n" if system "echo", "ok", "3"; # directly called
diff --git a/t/op/magic.t b/t/op/magic.t
index 61e4522913..7f08e06f85 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -135,6 +135,12 @@ __END__
:endofperl
EOT
}
+ if ($^O eq 'os390') { # no shebang
+ $headmaybe = <<EOH ;
+ eval 'exec ./perl -S \$0 \${1+"\$\@"}'
+ if 0;
+EOH
+ }
$s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
ok 19, open(SCRIPT, ">$script"), $!;
ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
diff --git a/t/op/misc.t b/t/op/misc.t
index 449d87cea1..7292ffebd4 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -36,6 +36,7 @@ for (@prgs){
$status = $?;
$results = `$CAT $tmpfile`;
$results =~ s/\n+$//;
+ $results =~ s/syntax error/syntax error/i;
$expected =~ s/\n+$//;
if ( $results ne $expected){
print STDERR "PROG: $switch\n$prog\n";
diff --git a/t/op/ord.t b/t/op/ord.t
index 37128382d8..ba943f4e8c 100755
--- a/t/op/ord.t
+++ b/t/op/ord.t
@@ -6,11 +6,13 @@ print "1..3\n";
# compile time evaluation
-if (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";}
+# 65 ASCII
+# 193 EBCDIC
+if (ord('A') == 65 || ord('A') == 193) {print "ok 1\n";} else {print "not ok 1\n";}
# run time evaluation
$x = 'ABC';
-if (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";}
+if (ord($x) == 65 || ord($x) == 193) {print "ok 2\n";} else {print "not ok 2\n";}
-if (chr 65 == A) {print "ok 3\n";} else {print "not ok 3\n";}
+if (chr 65 == 'A' || chr 193 == 'A') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/t/op/pack.t b/t/op/pack.t
index b8aece6b6b..9b7bc351f9 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -2,7 +2,7 @@
# $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
-print "1..56\n";
+print "1..60\n";
$format = "c2 x5 C C x s d i l a6";
# Need the expression in here to force ary[5] to be numeric. This avoids
@@ -30,7 +30,10 @@ print +($x = unpack("%32b69", "\001\002\004\010\020\040\100\200\017")) == 12
print +($x = unpack("%32B69", "\001\002\004\010\020\040\100\200\017")) == 9
? "ok 6\n" : "not ok 6 $x\n";
-print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == 129
+my $sum = 129; # ASCII
+$sum = 103 if ($^O eq 'os390'); # An EBCDIC variant.
+
+print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
? "ok 7\n" : "not ok 7 $x\n";
open(BIN, "./perl") || open(BIN, "./perl.exe")
@@ -154,3 +157,49 @@ foreach my $t (@templates) {
unless @t == 2 and (($t[0] == 12 and $t[1] == 34) or ($t =~ /[nv]/i));
print "ok ", $test++, "\n";
}
+
+# 57..60: uuencode/decode
+
+$in = join "", map { chr } 0..255;
+
+# just to be anal, we do some random tr/`/ /
+$uu = <<'EOUU';
+M` $"`P0%!@<("0H+# T.#Q`1$A,4%187&!D:&QP='A\@(2(C)"4F)R@I*BLL
+M+2XO,#$R,S0U-C<X.3H[/#T^/T!!0D-$149'2$E*2TQ-3D]045)35%565UA9
+M6EM<75Y?8&%B8V1E9F=H:6IK;&UN;W!Q<G-T=79W>'EZ>WQ]?G^`@8*#A(6&
+MAXB)BHN,C8Z/D)&2DY25EI>8F9J;G)V>GZ"AHJ.DI::GJ*FJJZRMKJ^PL;*S
+MM+6VM[BYNKN\O;Z_P,'"P\3%QL?(R<K+S,W.S]#1TM/4U=;7V-G:V]S=WM_@
+?X>+CY.7FY^CIZNOL[>[O\/'R\_3U]O?X^?K[_/W^_P `
+EOUU
+
+$_ = $uu;
+tr/ /`/;
+print "not " unless pack('u', $in) eq $_;
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+$in = "\x1f\x8b\x08\x08\x58\xdc\xc4\x35\x02\x03\x4a\x41\x50\x55\x00\xf3\x2a\x2d\x2e\x51\x48\xcc\xcb\x2f\xc9\x48\x2d\x52\x08\x48\x2d\xca\x51\x28\x2d\x4d\xce\x4f\x49\x2d\xe2\x02\x00\x64\x66\x60\x5c\x1a\x00\x00\x00";
+$uu = <<'EOUU';
+M'XL("%C<Q#4"`TI!4%4`\RHM+E%(S,LOR4@M4@A(+<I1*"U-SD])+>("`&1F
+&8%P:````
+EOUU
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+# 60 identical to 59 except that backquotes have been changed to spaces
+
+$uu = <<'EOUU';
+M'XL("%C<Q#4" TI!4%4 \RHM+E%(S,LOR4@M4@A(+<I1*"U-SD])+>(" &1F
+&8%P:
+EOUU
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+# Note that first uuencoding known 'text' data and then checking the
+# binary values of the uuencoded version would not be portable between
+# character sets. Uuencoding is meant for encoding binary data, not
+# text data.
diff --git a/t/op/quotemeta.t b/t/op/quotemeta.t
index 20dd312b31..913e07cdd6 100755
--- a/t/op/quotemeta.t
+++ b/t/op/quotemeta.t
@@ -1,14 +1,26 @@
#!./perl
+
print "1..15\n";
-$_=join "", map chr($_), 32..127;
+if ($^O eq 'os390') { # An EBCDIC variant.
+ $_=join "", map chr($_), 129..233;
+
+ # 105 characters - 52 letters = 53 backslashes
+ # 105 characters + 53 backslashes = 158 characters
+ $_=quotemeta $_;
+ if ( length == 158 ){print "ok 1\n"} else {print "not ok 1\n"}
+ # 104 non-backslash characters
+ if (tr/\\//cd == 104){print "ok 2\n"} else {print "not ok 2\n"}
+} else { # some ASCII descendant, then.
+ $_=join "", map chr($_), 32..127;
-# 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
-# 96 characters + 33 backslashes = 129 characters
-$_=quotemeta $_;
-if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
-# 95 non-backslash characters
-if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+ # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
+ # 96 characters + 33 backslashes = 129 characters
+ $_=quotemeta $_;
+ if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
+ # 95 non-backslash characters
+ if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+}
if (length quotemeta "" == 0){print "ok 3\n"} else {print "not ok 3\n"}
diff --git a/t/op/re_tests b/t/op/re_tests
index 7ac20c3852..a5295f5aae 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -151,8 +151,8 @@ a[bcd]+dcdcde adcdcde n - -
(bc+d$|ef*g.|h?i(j|k)) reffgz y $&-$1-$2 effgz-effgz-
((((((((((a)))))))))) a y $10 a
((((((((((a))))))))))\10 aa y $& aa
-((((((((((a))))))))))\41 aa n - -
-((((((((((a))))))))))\41 a! y $& a!
+((((((((((a))))))))))${bang} aa n - -
+((((((((((a))))))))))${bang} a! y $& a!
(((((((((a))))))))) a y $& a
multiple words of text uh-uh n - -
multiple words multiple words, yeah y $& multiple words
@@ -291,8 +291,8 @@ a[-]?c ac y $& ac
'(bc+d$|ef*g.|h?i(j|k))'i REFFGZ y $&-$1-$2 EFFGZ-EFFGZ-
'((((((((((a))))))))))'i A y $10 A
'((((((((((a))))))))))\10'i AA y $& AA
-'((((((((((a))))))))))\41'i AA n - -
-'((((((((((a))))))))))\41'i A! y $& A!
+'((((((((((a))))))))))${bang}'i AA n - -
+'((((((((((a))))))))))${bang}'i A! y $& A!
'(((((((((a)))))))))'i A y $& A
'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a))))))))))'i A y $1 A
'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a|b|c))))))))))'i C y $1 C
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 0ec069b19a..11b3ee31da 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -24,7 +24,7 @@ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
# Column 5 contains the expected result of double-quote
# interpolating that string after the match, or start of error message.
#
-# \n in the tests are interpolated.
+# \n in the tests are interpolated, as are variables of the form ${\w+}.
#
# If you want to add a regular expression test that can't be expressed
# in this format, don't add it here: put it in op/pat.t instead.
@@ -34,8 +34,6 @@ BEGIN {
@INC = '../lib' if -d '../lib';
}
-use re 'eval';
-
$iters = shift || 1; # Poor man performance suite, 10000 is OK.
open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') ||
@@ -46,6 +44,8 @@ $numtests = $.;
seek(TESTS,0,0);
$. = 0;
+$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
+
$| = 1;
print "1..$numtests\n# $iters iterations\n";
TEST:
@@ -58,6 +58,7 @@ while (<TESTS>) {
infty_subst(\$expect);
$pat = "'$pat'" unless $pat =~ /^[:']/;
$pat =~ s/\\n/\n/g;
+ $pat =~ s/(\$\{\w+\})/$1/eeg;
$subject =~ s/\\n/\n/g;
$expect =~ s/\\n/\n/g;
$expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
diff --git a/t/op/sort.t b/t/op/sort.t
index a6829e01e4..70341b9106 100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,20 +6,41 @@ print "1..21\n";
sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
+my $upperfirst = 'A' lt 'a';
+
+# Beware: in future this may become hairier because of possible
+# collation complications: qw(A a B c) can be sorted at least as
+# any of the following
+#
+# A a B b
+# A B a b
+# a b A B
+# a A b B
+#
+# All the above orders make sense.
+#
+# That said, EBCDIC sorts all small letters first, as opposed
+# to ASCII which sorts all big letters first.
+
@harry = ('dog','cat','x','Cain','Abel');
@george = ('gone','chased','yz','punished','Axed');
$x = join('', sort @harry);
-print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
+print "# 1: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 1\n" : "not ok 1\n");
$x = join('', sort( backwards @harry));
-print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 2: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 2\n" : "not ok 2\n");
$x = join('', sort @george, 'to', @harry);
-print ($x eq 'AbelAxedCaincatchaseddoggonepunishedtoxyz'?"ok 3\n":"not ok 3\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ?
+ 'AbelAxedCaincatchaseddoggonepunishedtoxyz' :
+ 'catchaseddoggonepunishedtoxyzAbelAxedCain' ;
+print "# 3: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ?"ok 3\n":"not ok 3\n");
@a = ();
@b = reverse @a;
@@ -47,7 +68,9 @@ print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
$sub = 'backwards';
$x = join('', sort $sub @harry);
-print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 10: x = $x, expected = '$expected'\n";
+print ($x eq $expected ? "ok 10\n" : "not ok 10\n");
# literals, combinations
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 7556c80a41..b9b4751c79 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -14,7 +14,7 @@ $SIG{__WARN__} = sub {
};
$w = 0;
-$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,65,3.0999);
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,ord('A'),3.0999);
if ($x eq ' hi 123 %foo 456 0A3.1' && $w == 0) {
print "ok 1\n";
} else {
diff --git a/t/op/stat.t b/t/op/stat.t
index 03bfd8da39..2207b40e30 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -13,9 +13,10 @@ print "1..58\n";
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_Dos = $^O eq 'dos';
+$Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
-$DEV = `ls -l /dev` unless ($Is_MSWin32 || $Is_Dos);
+$DEV = `ls -l /dev` unless $Is_Dosish;
unlink "Op.stat.tmp";
open(FOO, ">Op.stat.tmp");
@@ -34,7 +35,7 @@ close(FOO);
sleep 2;
-if ($Is_MSWin32 || $Is_Dos) { unlink "Op.stat.tmp2" }
+if ($Is_Dosish) { unlink "Op.stat.tmp2" }
else {
`rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
}
@@ -42,15 +43,19 @@ else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('Op.stat.tmp');
-if ($Is_MSWin32 || $Is_Dos || $Config{dont_use_nlink} || $nlink == 2)
- {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
+if ($Is_Dosish || $Config{dont_use_nlink})
+ {print "ok 3 # skipped: no link count\n";}
+elsif ($nlink == 2)
+ {print "ok 3\n";}
+else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
-if ( ($mtime && $mtime != $ctime)
- || $Is_MSWin32
- || $Is_Dos
+if ( $Is_Dosish
|| ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime) # Solaris tmpfs bug
|| $cwd =~ m#/afs/#
|| $^O eq 'amigaos') {
+ print "ok 4 # skipped: different semantic of mtime/ctime\n";
+}
+elsif ( ($mtime && $mtime != $ctime) ) {
print "ok 4\n";
}
else {
@@ -91,7 +96,9 @@ foreach ((12,13,14,15,16,17)) {
chmod 0700,'Op.stat.tmp';
if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
-if ($Is_MSWin32 or $Is_Dos or -x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
+if ($Is_Dosish) {print "ok 20 # skipped: -x by extension\n";}
+elsif (-x 'Op.stat.tmp') {print "ok 20\n";}
+else {print "not ok 20\n";}
if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
@@ -99,7 +106,7 @@ if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
-if (!($Is_MSWin32 || $Is_Dos) and `ls -l perl` =~ /^l.*->/) {
+if (!$Is_Dosish and `ls -l perl` =~ /^l.*->/) {
if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
}
else {
@@ -142,7 +149,9 @@ else
{print "not ok 33\n";}
if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
-if ($^O eq 'amigaos' or $Is_MSWin32 || $Is_Dos) {print "ok 35\n"; goto tty_test;}
+if ($^O eq 'amigaos' or $Is_Dosish) {
+ print "ok 35 # skipped: no -u\n"; goto tty_test;
+}
$cnt = $uid = 0;
diff --git a/t/op/subst.t b/t/op/subst.t
index 2d42eeb386..afa06ab772 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -1,11 +1,5 @@
#!./perl
-
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib' if -d '../lib';
-}
-
print "1..71\n";
$x = 'foo';
@@ -187,13 +181,21 @@ tr/a-z/A-Z/;
print $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ? "ok 52\n" : "not ok 52\n";
# same as tr/A-Z/a-z/;
-y[\101-\132][\141-\172];
+if ($^O eq 'os390') { # An EBCDIC variant.
+ y[\301-\351][\201-\251];
+} else { # Ye Olde ASCII. Or something like it.
+ y[\101-\132][\141-\172];
+}
print $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ? "ok 53\n" : "not ok 53\n";
-$_ = '+,-';
-tr/+--/a-c/;
-print $_ eq 'abc' ? "ok 54\n" : "not ok 54\n";
+if (ord("+") == ord(",") - 1 && ord(",") == ord("-") - 1 &&
+ ord("a") == ord("b") - 1 && ord("b") == ord("c") - 1) {
+ $_ = '+,-';
+ tr/+--/a-c/;
+ print "not " unless $_ eq 'abc';
+}
+print "ok 54\n";
$_ = '+,-';
tr/+\--/a\/c/;
diff --git a/t/op/taint.t b/t/op/taint.t
index f2181d82fd..d2cae8e70a 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -15,6 +15,10 @@ BEGIN {
use strict;
use Config;
+# We do not want the whole taint.t to fail
+# just because Errno possibly failing.
+eval { require Errno; import Errno };
+
my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $Is_Dos = $^O eq 'dos';
@@ -360,7 +364,9 @@ else {
test 71, eval { open FOO, $foo } eq '', 'open for read';
test 72, $@ eq '', $@; # NB: This should be allowed
- test 73, $! == 2 || ($Is_Dos && $! == 22); # File not found
+
+ # Try first new style but allow also old style.
+ test 73, $!{ENOENT} || $! == 2 || ($Is_Dos && $! == 22); # File not found
test 74, eval { open FOO, "> $foo" } eq '', 'open for write';
test 75, $@ =~ /^Insecure dependency/, $@;
diff --git a/t/op/universal.t b/t/op/universal.t
index bd6c73afe9..bde78fd04c 100755
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -75,7 +75,11 @@ test ! (eval { $a->VERSION(2.719) }) &&
test (eval { $a->VERSION(2.718) }) && ! $@;
my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
-test $subs eq "VERSION can isa";
+if ('a' lt 'A') {
+ test $subs eq "can isa VERSION";
+} else {
+ test $subs eq "VERSION can isa";
+}
test $a->isa("UNIVERSAL");
@@ -86,7 +90,11 @@ test $a->isa("UNIVERSAL");
my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
# XXX import being here is really a bug
-test $sub2 eq "VERSION can import isa";
+if ('a' lt 'A') {
+ test $sub2 eq "can import isa VERSION";
+} else {
+ test $sub2 eq "VERSION can import isa";
+}
eval 'sub UNIVERSAL::sleep {}';
test $a->can("sleep");
View Lorry Controller Status