From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Wed, 13 Dec 2006 18:32:22 +0000 (-0800)
Subject: Fixes for the test suite on OS/2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=295d5f02f7120b75c639212780c96fcd67ffb3d6;p=p5sagit%2Fp5-mst-13.2.git

Fixes for the test suite on OS/2
Message-ID: <20061214023222.GA29084@powdermilk.math.berkeley.edu>

p4raw-id: //depot/perl@29578
---

diff --git a/ext/IO/t/io_unix.t b/ext/IO/t/io_unix.t
index 6d77062..33ee056 100644
--- a/ext/IO/t/io_unix.t
+++ b/ext/IO/t/io_unix.t
@@ -38,6 +38,13 @@ BEGIN {
 
 $PATH = "sock-$$";
 
+if ($^O eq 'os2') {	# Can't create sockets with relative path...
+  require Cwd;
+  my $d = Cwd::cwd();
+  $d =~ s/^[a-z]://i;
+  $PATH = "$d/$PATH";
+}
+
 # Test if we can create the file within the tmp directory
 if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
     print "1..0 # Skip: cannot open '$PATH' for write\n";
diff --git a/lib/ExtUtils/t/eu_command.t b/lib/ExtUtils/t/eu_command.t
index f8199cd..2d2fdba 100644
--- a/lib/ExtUtils/t/eu_command.t
+++ b/lib/ExtUtils/t/eu_command.t
@@ -263,6 +263,7 @@ BEGIN {
 {
     { local @ARGV = 'd2utest'; mkpath; }
     open(FILE, '>d2utest/foo');
+    binmode(FILE);
     print FILE "stuff\015\012and thing\015\012";
     close FILE;
 
diff --git a/lib/Time/Local.t b/lib/Time/Local.t
index a6120e8..2ccea67 100755
--- a/lib/Time/Local.t
+++ b/lib/Time/Local.t
@@ -55,7 +55,8 @@ my @neg_time =
 # Use 3 days before the start of the epoch because with Borland on
 # Win32 it will work for -3600 _if_ your time zone is +01:00 (or
 # greater).
-my $neg_epoch_ok = defined ((localtime(-259200))[0]) ? 1 : 0;
+my $neg_epoch_ok =	# take into account systems with unsigned time too
+    (defined ((localtime(-259200))[0]) and (localtime(-259200))[5] == 69) ? 1 : 0;
 
 # use vmsish 'time' makes for oddness around the Unix epoch
 if ($^O eq 'VMS') {
diff --git a/os2/OS2/ExtAttr/t/os2_ea.t b/os2/OS2/ExtAttr/t/os2_ea.t
index a1da398..947e2f1 100644
--- a/os2/OS2/ExtAttr/t/os2_ea.t
+++ b/os2/OS2/ExtAttr/t/os2_ea.t
@@ -37,9 +37,14 @@ system 'cmd', '/c', 'echo OK > t.out';
   print "ok 2\n";
   
   keys %a == 0 ? print "ok 3\n" : print "not ok 3\n";
-  $a{'++'} = '---';
+# Standard Extended Attributes (SEAs) have a dot (.) as a prefix.
+# This identifies the extended attribute as a SEA. The leading dot is reserved,
+# so applications should not define extended attributes that start with a dot.
+# Also, extended attributes 
+# that start with the characters $, @, &, or + are reserved for system use.
+  $a{'X--Y'} = '---';		# '++', -++', '!++', 'X++Y' fail on JFS
   print "ok 4\n";
-  $a{'AAA'} = 'xyz';
+  $a{'AAA'} = 'xyz';		# Name is going to be uppercased???
   print "ok 5\n";
 }
 
@@ -51,10 +56,10 @@ system 'cmd', '/c', 'echo OK > t.out';
   my $c = keys %a;
   $c == 2 ? print "ok 7\n" : print "not ok 7\n# c=$c\n";
   my @b = sort keys %a;
-  "@b" eq '++ AAA' ? print "ok 8\n" : print "not ok 8\n# keys=`@b'\n";
-  $a{'++'} eq '---' ? print "ok 9\n" : print "not ok 9\n";;
+  "@b" eq 'AAA X--Y' ? print "ok 8\n" : print "not ok 8\n# keys=`@b'\n";
+  $a{'X--Y'} eq '---' ? print "ok 9\n" : print "not ok 9\n";;
   $a{'AAA'} eq 'xyz' ? print "ok 10\n" : print "not ok 10\n# aaa->`$a{AAA}'\n";
-  $c = delete $a{'++'};
+  $c = delete $a{'X--Y'};
   $c eq '---' ? print "ok 11\n" : print "not ok 11\n# deleted->`$c'\n";;
 }
 
@@ -70,10 +75,11 @@ print "ok 12\n";
   "@b" eq 'AAA' ? print "ok 15\n" : print "not ok 15\n";
   $a{'AAA'} eq 'xyz' ? print "ok 16\n" : print "not ok 16\n";;
   ! exists $a{'+'} ? print "ok 17\n" : print "not ok 17\n";;
-  ! defined $a{'+'} ? print "ok 18\n" : print "not ok 18\n# ->`$a{'++'}'\n";;
-  ! exists $a{'++'} ? print "ok 19\n" : print "not ok 19\n";;
-  ! defined $a{'++'} ? print "ok 20\n" : print "not ok 20\n# ->`$a{'++'}'\n";;
+  ! defined $a{'+'} ? print "ok 18\n" : print "not ok 18\n# ->`$a{'X--Y'}'\n";;
+  ! exists $a{'X--Y'} ? print "ok 19\n" : print "not ok 19\n";;
+  ! defined $a{'X--Y'} ? print "ok 20\n" : print "not ok 20\n# ->`$a{'X--Y'}'\n";;
 }
 
 print "ok 21\n";
 unlink 't.out';
+ 
diff --git a/t/io/fs.t b/t/io/fs.t
index 283a5a8..5b2de64 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -203,7 +203,7 @@ SKIP: {
     skip "has fchown", 1 if ($Config{d_fchown} || "") eq "define";
     open(my $fh, "<", "a");
     eval { chown(0, 0, $fh); };
-    like($@, qr/^The fchown function is unimplemented at/, "fchown is unimplemented");
+    like($@, qr/^The f?chown function is unimplemented at/, "fchown is unimplemented");
 }
 
 is(rename('a','b'), 1, "rename a b");
diff --git a/t/op/stat.t b/t/op/stat.t
index cde2974..7cb6b1b 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -41,7 +41,7 @@ my $Curdir = File::Spec->curdir;
 my $tmpfile = 'Op_stat.tmp';
 my $tmpfile_link = $tmpfile.'2';
 
-
+chmod 0666, $tmpfile;
 1 while unlink $tmpfile;
 open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
 close FOO;
@@ -508,5 +508,6 @@ SKIP: {
 }
 
 END {
+    chmod 0666, $tmpfile;
     1 while unlink $tmpfile;
 }