Required OS/2-related patches

To: perl5-porters@perl.org (Mailing list Perl5)
Message-Id: <199905281611.MAA02037@monk.mps.ohio-state.edu>

p4raw-id: //depot/cfgperl@3496

diff --git a/os2/os2.c b/os2/os2.c
index 7f011f7..09135a6 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -412,6 +412,7 @@ result(int flag, int pid)
 #define EXECF_EXEC 1
 #define EXECF_TRUEEXEC 2
 #define EXECF_SPAWN_NOWAIT 3
+#define EXECF_SPAWN_BYFLAG 4
 
 /* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
 
@@ -587,7 +588,7 @@ U32 addflag;
            rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
        else if (execf == EXECF_SPAWN_NOWAIT)
            rc = spawnvp(flag,tmps,PL_Argv);
-        else                           /* EXECF_SPAWN */
+        else                           /* EXECF_SPAWN, EXECF_SPAWN_BYFLAG */
            rc = result(trueflag, 
                        spawnvp(flag,tmps,PL_Argv));
 #endif 
@@ -813,49 +814,9 @@ U32 addflag;
     return rc;
 }
 
-/* Array spawn.  */
-int
-do_aspawn(really,mark,sp)
-SV *really;
-register SV **mark;
-register SV **sp;
-{
-    dTHR;
-    register char **a;
-    char *tmps = NULL;
-    int rc;
-    int flag = P_WAIT, trueflag, err, secondtry = 0;
-    STRLEN n_a;
-
-    if (sp > mark) {
-       New(1301,PL_Argv, sp - mark + 3, char*);
-       a = PL_Argv;
-
-       if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
-               ++mark;
-               flag = SvIVx(*mark);
-       }
-
-       while (++mark <= sp) {
-           if (*mark)
-               *a++ = SvPVx(*mark, n_a);
-           else
-               *a++ = "";
-       }
-       *a = Nullch;
-
-       rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0);
-    } else
-       rc = -1;
-    do_execfree();
-    return rc;
-}
-
 /* Try converting 1-arg form to (usually shell-less) multi-arg form. */
 int
-do_spawn2(cmd, execf)
-char *cmd;
-int execf;
+do_spawn3(char *cmd, int execf, int flag)
 {
     register char **a;
     register char *s;
@@ -936,6 +897,8 @@ int execf;
                 rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
            else if (execf == EXECF_SPAWN_NOWAIT)
                 rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
+           else if (execf == EXECF_SPAWN_BYFLAG)
+                rc = spawnl(flag,shell,shell,copt,cmd,(char*)0);
            else {
                /* In the ak code internal P_NOWAIT is P_WAIT ??? */
                rc = result(P_WAIT,
@@ -968,7 +931,7 @@ int execf;
     }
     *a = Nullch;
     if (PL_Argv[0])
-       rc = do_spawn_ve(NULL, 0, execf, cmd, mergestderr);
+       rc = do_spawn_ve(NULL, flag, execf, cmd, mergestderr);
     else
        rc = -1;
     if (news)
@@ -977,25 +940,67 @@ int execf;
     return rc;
 }
 
+/* Array spawn.  */
+int
+do_aspawn(really,mark,sp)
+SV *really;
+register SV **mark;
+register SV **sp;
+{
+    dTHR;
+    register char **a;
+    int rc;
+    int flag = P_WAIT, flag_set = 0;
+    STRLEN n_a;
+
+    if (sp > mark) {
+       New(1301,PL_Argv, sp - mark + 3, char*);
+       a = PL_Argv;
+
+       if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
+               ++mark;
+               flag = SvIVx(*mark);
+               flag_set = 1;
+
+       }
+
+       while (++mark <= sp) {
+           if (*mark)
+               *a++ = SvPVx(*mark, n_a);
+           else
+               *a++ = "";
+       }
+       *a = Nullch;
+
+       if (flag_set && (a == PL_Argv + 1)) { /* One arg? */
+           rc = do_spawn3(a[-1], EXECF_SPAWN_BYFLAG, flag);
+       } else
+           rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0);
+    } else
+       rc = -1;
+    do_execfree();
+    return rc;
+}
+
 int
 do_spawn(cmd)
 char *cmd;
 {
-    return do_spawn2(cmd, EXECF_SPAWN);
+    return do_spawn3(cmd, EXECF_SPAWN, 0);
 }
 
 int
 do_spawn_nowait(cmd)
 char *cmd;
 {
-    return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
+    return do_spawn3(cmd, EXECF_SPAWN_NOWAIT,0);
 }
 
 bool
 do_exec(cmd)
 char *cmd;
 {
-    do_spawn2(cmd, EXECF_EXEC);
+    do_spawn3(cmd, EXECF_EXEC, 0);
     return FALSE;
 }
 
@@ -1003,7 +1008,7 @@ bool
 os2exec(cmd)
 char *cmd;
 {
-    return do_spawn2(cmd, EXECF_TRUEEXEC);
+    return do_spawn3(cmd, EXECF_TRUEEXEC, 0);
 }
 
 PerlIO *

diff --git a/t/lib/bigfloatpm.t b/t/lib/bigfloatpm.t
index ebec667..42cd958 100755 (executable)
--- a/t/lib/bigfloatpm.t
+++ b/t/lib/bigfloatpm.t
@@ -185,9 +185,9 @@ $Math::BigFloat::rnd_mode = 'trunc'
 -1.35:-1:-1.3
 -0.006:-1:0
 -0.006:-2:0
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = 'zero'
 +2.23:-1:2.2
 -2.23:-1:-2.2
@@ -198,10 +198,10 @@ $Math::BigFloat::rnd_mode = 'zero'
 +2.35:-1:2.3
 -2.35:-1:-2.3
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = '+inf'
 +3.23:-1:3.2
 -3.23:-1:-3.2
@@ -212,10 +212,10 @@ $Math::BigFloat::rnd_mode = '+inf'
 +3.35:-1:3.4
 -3.35:-1:-3.3
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = '-inf'
 +4.23:-1:4.2
 -4.23:-1:-4.2
@@ -226,10 +226,10 @@ $Math::BigFloat::rnd_mode = '-inf'
 +4.35:-1:4.3
 -4.35:-1:-4.4
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.007
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = 'odd'
 +5.23:-1:5.2
 -5.23:-1:-5.2
@@ -240,10 +240,10 @@ $Math::BigFloat::rnd_mode = 'odd'
 +5.35:-1:5.3
 -5.35:-1:-5.3
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.007
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = 'even'
 +6.23:-1:6.2
 -6.23:-1:-6.2
@@ -254,10 +254,10 @@ $Math::BigFloat::rnd_mode = 'even'
 +6.35:-1:6.4
 -6.35:-1:-6.4
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 &fcmp
 abc:abc:
 abc:+0:

diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
index 7a4556d..2dd32c9 100644 (file)
--- a/t/lib/io_unix.t
+++ b/t/lib/io_unix.t
@@ -21,6 +21,13 @@ BEGIN {
        elsif ($Config{'extensions'} !~ /\bIO\b/) {
            $reason = 'IO extension unavailable';
        }
+       elsif ($^O eq 'os2') {
+           use IO::Socket;
+
+           eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
+             or $@ !~ /not implemented/ or
+               $reason = 'compiled without TCP/IP stack v4';
+       }
        undef $reason if $^O eq 'VMS' and $Config{d_socket};
        if ($reason) {
            print "1..0 # Skip: $reason\n";

diff --git a/t/op/groups.t b/t/op/groups.t
index d22d8f0..f46af93 100755 (executable)
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -65,6 +65,11 @@ EOM
     quit();
 }
 
+unless (eval { getgrgid(0); 1 }) {
+    print "1..0 # Skip: getgrgid() not implemented\n";
+    exit 0;
+}
+
 # Remember that group names can contain whitespace, '-', et cetera.
 # That is: do not \w, do not \S.
 if ($groups =~ /groups=(.+)( [ug]id=|$)/) {

diff --git a/t/op/stat.t b/t/op/stat.t
index ae627f6..60c70f2 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -19,23 +19,34 @@ chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
 $DEV = `ls -l /dev` unless $Is_Dosish;
 
 unlink "Op.stat.tmp";
-open(FOO, ">Op.stat.tmp");
-
-# hack to make Apollo update link count:
-$junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-    $blksize,$blocks) = stat(FOO);
-if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
-if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {print "ok 2\n";}
-else {print "# |$mtime| vs |$ctime|\nnot ok 2\n";}
-
-print FOO "Now is the time for all good men to come to.\n";
-close(FOO);
-
-sleep 2;
+if (open(FOO, ">Op.stat.tmp")) {
+  # hack to make Apollo update link count:
+  $junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
+
+  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(FOO);
+  if ($nlink == 1) {
+    print "ok 1\n";
+  }
+  else {
+    print "# res=$res, nlink=$nlink.\nnot ok 1\n";
+  }
+  if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {
+    print "ok 2\n";
+  }
+  else {
+    print "# |$mtime| vs |$ctime|\nnot ok 2\n";
+  }
+
+  print FOO "Now is the time for all good men to come to.\n";
+  close(FOO);
+
+  sleep 2;
+} else {
+  print "# open failed: $!\nnot ok 1\nnot ok 2\n";
+}
 
-if ($Is_Dosish) { 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`;
 }
@@ -65,7 +76,7 @@ else {
 }
 print "#4      :$mtime: should != :$ctime:\n";
 
-unlink "Op.stat.tmp";
+unlink "Op.stat.tmp" or print "# unlink failed: $!\n";
 if ($Is_MSWin32) {  open F, '>Op.stat.tmp' and close F }
 else             { `touch Op.stat.tmp` }
 
@@ -76,7 +87,7 @@ $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
 if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
 if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
 
-unlink 'Op.stat.tmp';
+unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
 $olduid = $>;          # can't test -r if uid == 0
 $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
 chmod 0,'Op.stat.tmp';
@@ -95,7 +106,7 @@ foreach ((12,13,14,15,16,17)) {
 
 # in ms windows, Op.stat.tmp inherits owner uid from directory
 # not sure about os/2, but chown is harmless anyway
-chown $>,'Op.stat.tmp';
+eval { chown $>,'Op.stat.tmp'; 1 } or print "# $@" ;
 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";}
@@ -261,4 +272,4 @@ $_ = 'Op.stat.tmp';
 if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
 if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
 
-unlink 'Op.stat.tmp';
+unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";

diff --git a/util.c b/util.c
index 5615d47..82f094c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2090,6 +2090,7 @@ my_popen(char *cmd, char *mode)
            PerlLIO_dup2(p[THIS], *mode == 'r');
            PerlLIO_close(p[THIS]);
        }
+#ifndef OS2
        if (doexec) {
 #if !defined(HAS_FCNTL) || !defined(F_SETFD)
            int fd;
@@ -2104,6 +2105,7 @@ my_popen(char *cmd, char *mode)
            do_exec3(cmd,pp[1],did_pipes);      /* may or may not use the shell */
            PerlProc__exit(1);
        }
+#endif /* defined OS2 */
        /*SUPPRESS 560*/
        if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
            sv_setiv(GvSV(tmpgv), (IV)getpid());