Re: [PATCH] Re: perl winpid?

Message-ID: <20050211040434.GA3824@efn.org>

p4raw-id: //depot/perl@23961

diff --git a/MANIFEST b/MANIFEST
index 2938dee..666bce6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2522,6 +2522,7 @@ t/japh/abigail.t          Obscure tests
 t/lib/1_compile.t              See if the various libraries and extensions compile
 t/lib/commonsense.t            See if configuration meets basic needs
 t/lib/compmod.pl               Helper for 1_compile.t
+t/lib/cygwin.t                 Builtin cygwin function tests
 t/lib/Devel/switchd.pm         Module for t/run/switchd.t
 t/lib/Dev/Null.pm              Module for testing Test::Harness
 t/lib/dprof/test1_t            Perl code profiler tests

diff --git a/README.cygwin b/README.cygwin
index a2748f3..fa2f549 100644 (file)
--- a/README.cygwin
+++ b/README.cygwin
@@ -369,6 +369,8 @@ A C<fork()> failure may result in the following tests failing:
 
 See comment on fork in L<Miscellaneous> below.
 
+=head1 Specific features of the Cygwin port
+
 =head2 Script Portability on Cygwin
 
 Cygwin does an outstanding job of providing UNIX-like semantics on top of
@@ -470,6 +472,25 @@ F<http://www.cygwin.com/setup.exe> to install it and run rebaseall.
 
 =back
 
+=head2 Prebuilt methods:
+
+=over 4
+
+=item C<Cwd::cwd>
+
+Returns current working directory.
+
+=item C<Cygwin::pid_to_winpid>
+
+Translates a cygwin pid to the corresponding Windows pid (which may or
+may not be the same).
+
+=item C<Cygwin::winpid_to_pid>
+
+Translates a Windows pid to the corresponding cygwin pid (if any).
+
+=back
+
 =head1 INSTALL PERL ON CYGWIN
 
 This will install Perl, including I<man> pages.

diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c
index 0e9d07d..ceb2e81 100644 (file)
--- a/cygwin/cygwin.c
+++ b/cygwin/cygwin.c
@@ -9,6 +9,7 @@
 
 #include <unistd.h>
 #include <process.h>
+#include <sys/cygwin.h>
 
 /*
  * pp_system() implemented via spawn()
@@ -155,6 +156,39 @@ XS(Cygwin_cwd)
     XSRETURN_UNDEF;
 }
 
+static
+XS(XS_Cygwin_pid_to_winpid)
+{
+    dXSARGS;
+    if (items != 1)
+        Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
+    pid_t pid = (pid_t)SvIV(ST(0));
+    pid_t RETVAL;
+    dXSTARG;
+    if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
+       XSprePUSH; PUSHi((IV)RETVAL);
+        XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(XS_Cygwin_winpid_to_pid)
+{
+    dXSARGS;
+    if (items != 1)
+        Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
+    pid_t pid = (pid_t)SvIV(ST(0));
+    pid_t RETVAL;
+    dXSTARG;
+    if ((RETVAL = cygwin32_winpid_to_pid(pid)) > 0) {
+        XSprePUSH; PUSHi((IV)RETVAL);
+        XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+
 void
 init_os_extras(void)
 {
@@ -162,4 +196,6 @@ init_os_extras(void)
     dTHX;
 
     newXS("Cwd::cwd", Cygwin_cwd, file);
+    newXS("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file);
+    newXS("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file);
 }

diff --git a/t/lib/cygwin.t b/t/lib/cygwin.t
new file mode 100644 (file)
index 0000000..0148546
--- /dev/null
+++ b/t/lib/cygwin.t
@@ -0,0 +1,31 @@
+#!perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('../lib');
+    unless ($^O eq "cygwin") {
+       print "1..0 # skipped: cygwin specific test\n";
+       exit 0;
+    }
+}
+
+use Test::More tests => 4;
+
+is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$,
+   "perl pid translates to itself");
+
+my $parent = getppid;
+SKIP: {
+    skip "test not run from cygwin process", 1 if $parent <= 1;
+    is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($parent)), $parent,
+       "parent pid translates to itself");
+}
+
+my $catpid = open my $cat, "|cat" or die "Couldn't cat: $!";
+open my $ps, "ps|" or die "Couldn't do ps: $!";
+my ($catwinpid) = map /^.\s+$catpid\s+\d+\s+\d+\s+(\d+)/, <$ps>;
+close($ps);
+
+is(Cygwin::winpid_to_pid($catwinpid), $catpid, "winpid to pid");
+is(Cygwin::pid_to_winpid($catpid), $catwinpid, "pid to winpid");
+close($cat);