File: GetCurrentThreadId.t

package info (click to toggle)
perl 5.24.1-3%2Bdeb9u7
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 107,108 kB
  • sloc: perl: 559,649; ansic: 293,918; sh: 67,316; pascal: 7,632; cpp: 3,895; makefile: 2,436; xml: 2,410; yacc: 989; sed: 6; lisp: 1
file content (38 lines) | stat: -rw-r--r-- 949 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
use strict;
use Config qw(%Config);
use Test;
use Win32;

my $fork_emulation = $Config{ccflags} =~ /PERL_IMPLICIT_SYS/;

my $tests = $fork_emulation ? 4 : 2;
plan tests => $tests;

my $pid = $$+0; # make sure we don't copy any magic to $pid

if ($^O eq "cygwin") {
    skip(!defined &Cygwin::pid_to_winpid,
	 Cygwin::pid_to_winpid($pid),
	 Win32::GetCurrentProcessId());
}
else {
    ok($pid, Win32::GetCurrentProcessId());
}

if ($fork_emulation) {
    # This test relies on the implementation detail that the fork() emulation
    # uses the negative value of the thread id as a pseudo process id.
    if (my $child = fork) {
	waitpid($child, 0);
	exit 0;
    }
    ok(-$$, Win32::GetCurrentThreadId());

    # GetCurrentProcessId() should still return the real PID
    ok($pid, Win32::GetCurrentProcessId());
    ok($$ != Win32::GetCurrentProcessId());
}
else {
    # here we just want to see something.
    ok(Win32::GetCurrentThreadId() > 0);
}