diff options
| -rw-r--r-- | os2/os2.c | 99 | ||||
| -rwxr-xr-x | t/lib/bigfloatpm.t | 46 | ||||
| -rw-r--r-- | t/lib/io_unix.t | 7 | ||||
| -rwxr-xr-x | t/op/groups.t | 5 | ||||
| -rwxr-xr-x | t/op/stat.t | 51 | ||||
| -rw-r--r-- | util.c | 2 |
6 files changed, 120 insertions, 90 deletions
@@ -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 ebec667280..42cd9583d1 100755 --- 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 7a4556d215..2dd32c946d 100644 --- 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 d22d8f07ad..f46af93bd3 100755 --- 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 ae627f6070..60c70f2bb7 100755 --- 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"; @@ -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()); |