File: 03_threads.t

package info (click to toggle)
libwx-perl 1%3A0.9932-9
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 5,300 kB
  • sloc: cpp: 11,064; perl: 8,603; ansic: 711; makefile: 53
file content (87 lines) | stat: -rwxr-xr-x 2,571 bytes parent folder | download | duplicates (5)
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
#!/usr/bin/perl -w

use strict;
use Config;
use if !$Config{useithreads} => 'Test::More' => skip_all => 'no threads';
use threads;

use Wx qw(:everything);
use Wx::IPC;
use if !Wx::_wx_optmod_ipc(), 'Test::More' => skip_all => 'No IPC Support';
use if !Wx::wxTHREADS, 'Test::More' => skip_all => 'No thread support';
use if !Wx::wxMSW, 'Test::More' => skip_all => 'Hangs on none wxMSW platforms';
# the hang is due to deadlock over fifo client / server in same process I think
use Test::More tests => 4;

my @keeps;

{
    my $servicename1 = create_service_name('WxInstallationTestsOne');
    my $servicename2 = create_service_name('WxInstallationTestsTwo');
    
    my $server1 =  Wx::Server->new;
    $server1->Create($servicename1);
    
    my $server2 =  Wx::Server->new;;
    $server2->Create($servicename2);
    
    my $client1 = Wx::Client->new;
    my $conn1 = $client1->MakeConnection('', $servicename1, 'Default Topic');
    
    my $client2 = Wx::Client->new;
    my $conn2 = $client2->MakeConnection('', $servicename2, 'Default Topic');
    
    push @keeps, ($server1, $client1, $conn1);
    
    $conn1->Disconnect;
    $conn2->Disconnect;
    
    # $server2, $client2, $conn2 destroyed when current scope ends
}

my $t = threads->create
  ( sub {
        ok( 1, 'In thread' );
    } );
ok( 1, 'Before join' );
$t->join;
ok( 1, 'After join' );

sub create_service_name {
    my($basename) = @_;
    # Our service name will be a unix domain socket
    # or an arbitrary DDE name on windows.
    # We also have to end up with the same path
    # on the client and the server, of course.
    
    # We are going to have 1 instance only
    # but it would be possible to create
    # some form of scheme where multiple
    # instances created some filesystem
    # directory that a client could query
    # for available running instances
    # and their service names.
    
    my $servicedir;
    
    if( $^O =~ /^mswin/i ) {
        require Win32;
        my $FOLDER_LOCAL_APPDATA = 0x001C;
        $servicedir = Win32::GetFolderPath($FOLDER_LOCAL_APPDATA, 1);
        $servicedir = Win32::GetShortPathName($servicedir);
        $servicedir =~ s/\\/\//g;
        $servicedir .= '/wxIPC';
    } elsif( $^O =~ /^darwin/i ) {
        $servicedir = $ENV{HOME} . '/Library/Application Support/wxIPC';
    } else {
        $servicedir = $ENV{HOME} . '/.wxIPC';
    }
    
    mkdir($servicedir, 0700) unless -d $servicedir;
    chmod(0700, $servicedir);
    my $servicename = qq($servicedir/$basename);
    return $servicename;
}


END { ok( 1, 'At END' ) };