This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[win32] merge changes#989,990,992 from maintbranch
[perl5.git] / t / op / ipcmsg.t
CommitLineData
9b599b2a
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8my @define;
9
10BEGIN {
11 @define = qw(
12 IPC_PRIVATE
13 IPC_RMID
14 IPC_NOWAIT
15 IPC_STAT
16 S_IRWXU
17 S_IRWXG
18 S_IRWXO
19 );
20}
21
22use Config;
23use vars map { '$' . $_ } @define;
24
25BEGIN {
26 unless($Config{'d_msgget'} eq 'define' &&
27 $Config{'d_msgctl'} eq 'define' &&
28 $Config{'d_msgsnd'} eq 'define' &&
29 $Config{'d_msgrcv'} eq 'define') {
55d729e4 30 print "1..0\n";
9b599b2a
GS
31 exit;
32 }
38b8243a
GS
33
34 use strict;
35
9b599b2a
GS
36 my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
37 my %done = ();
38 my %define = ();
39
40 sub process_file {
38b8243a 41 my($file,$level) = @_;
9b599b2a
GS
42
43 return unless defined $file;
44
45 my $path = undef;
46 my $dir;
47 foreach $dir (@incpath) {
48 my $tmp = $dir . "/" . $file;
49 next unless -r $tmp;
50 $path = $tmp;
51 last;
52 }
53
54 return if exists $done{$path};
55 $done{$path} = 1;
56
38b8243a 57 if(not defined $path and $level == 0) {
9b599b2a
GS
58 warn "Cannot find '$file'";
59 return;
60 }
61
38b8243a 62 local(*F);
9b599b2a 63 open(F,$path) or return;
38b8243a
GS
64 $level = 1 unless defined $level;
65 my $indent = " " x $level;
66 print "#$indent open $path\n";
9b599b2a
GS
67 while(<F>) {
68 s#/\*.*(\*/|$)##;
69
38b8243a
GS
70 if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
71 print "#${indent} include $1\n";
72 process_file($1,$level+1);
73 print "#${indent} done include $1\n";
74 print "#${indent} back in $path\n";
75 }
9b599b2a
GS
76
77 s/(?:\([^)]*\)\s*)//;
78
38b8243a
GS
79 if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
80 print "#${indent} define $1 $2\n";
81 $define{$1} = $2;
82 }
9b599b2a
GS
83 }
84 close(F);
38b8243a 85 print "#$indent close $path\n";
9b599b2a
GS
86 }
87
88 process_file("sys/sem.h");
89 process_file("sys/ipc.h");
90 process_file("sys/stat.h");
91
38b8243a 92 foreach my $d (@define) {
9b599b2a
GS
93 while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
94 $define{$d} = exists $define{$define{$d}}
95 ? $define{$define{$d}} : undef;
96 }
97 unless(defined $define{$d}) {
38b8243a
GS
98 print "# $d undefined\n";
99 print "1..0\n";
9b599b2a 100 exit;
38b8243a
GS
101 }
102 {
103 no strict 'refs';
104 ${ $d } = eval $define{$d};
105 }
9b599b2a
GS
106 }
107}
108
109use strict;
110
111print "1..6\n";
112
113my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO)
114 || die "msgget failed: $!\n";
115
116print "ok 1\n";
117
118#Putting a message on the queue
119my $msgtype = 1;
120my $msgtext = "hello";
121
122msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
123print "ok 2\n";
124
125my $data;
126msgctl($msg,$IPC_STAT,$data) or print "not ";
127print "ok 3\n";
128
129print "not " unless length($data);
130print "ok 4\n";
131
132my $msgbuf;
133msgrcv($msg,$msgbuf,256,0,$IPC_NOWAIT) or print "not ";
134print "ok 5\n";
135
136my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
137
138print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
139print "ok 6\n";
140
141msgctl($msg,$IPC_RMID,0);
142