xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33)
1use Test2::Tools::Tiny;
2use Test2::Util qw/get_tid USE_THREADS try ipc_separator/;
3use File::Temp qw/tempfile/;
4use File::Spec;
5use List::Util qw/shuffle/;
6use strict;
7use warnings;
8
9if ($] lt "5.008") {
10    print "1..0 # SKIP Test cannot run on perls below 5.8.0\n";
11    exit 0;
12}
13
14sub simple_capture(&) {
15    my $code = shift;
16
17    my ($err, $out) = ("", "");
18
19    my ($ok, $e);
20    {
21        local *STDOUT;
22        local *STDERR;
23
24        ($ok, $e) = try {
25            open(STDOUT, '>', \$out) or die "Failed to open a temporary STDOUT: $!";
26            open(STDERR, '>', \$err) or die "Failed to open a temporary STDERR: $!";
27
28            $code->();
29        };
30    }
31
32    die $e unless $ok;
33
34    return {
35        STDOUT => $out,
36        STDERR => $err,
37    };
38}
39
40require Test2::IPC::Driver::Files;
41ok(my $ipc = Test2::IPC::Driver::Files->new, "Created an IPC instance");
42ok($ipc->isa('Test2::IPC::Driver::Files'), "Correct type");
43ok($ipc->isa('Test2::IPC::Driver'), "inheritance");
44
45ok(-d $ipc->tempdir, "created temp dir");
46is($ipc->pid, $$, "stored pid");
47is($ipc->tid, get_tid(), "stored the tid");
48
49my $hid = join ipc_separator, qw'12345 1 1 1';
50
51$ipc->add_hub($hid);
52my $hubfile = File::Spec->catfile($ipc->tempdir, "HUB" . ipc_separator . $hid);
53ok(-f $hubfile, "wrote hub file");
54if(ok(open(my $fh, '<', $hubfile), "opened hub file")) {
55    my @lines = <$fh>;
56    close($fh);
57    is_deeply(
58        \@lines,
59        [ "$$\n", get_tid() . "\n" ],
60        "Wrote pid and tid to hub file"
61    );
62}
63
64{
65    package Foo;
66    use base 'Test2::Event';
67}
68
69$ipc->send($hid, bless({ foo => 1 }, 'Foo'));
70$ipc->send($hid, bless({ bar => 1 }, 'Foo'));
71
72my $sep = ipc_separator;
73opendir(my $dh, $ipc->tempdir) || die "Could not open tempdir: !?";
74my @files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB${sep}$hid/ } readdir($dh);
75closedir($dh);
76is(@files, 2, "2 files added to the IPC directory");
77
78my @events = $ipc->cull($hid);
79is_deeply(
80    \@events,
81    [{ foo => 1 }, { bar => 1 }],
82    "Culled both events"
83);
84
85opendir($dh, $ipc->tempdir) || die "Could not open tempdir: !?";
86@files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB$sep$hid/ } readdir($dh);
87closedir($dh);
88is(@files, 0, "All files collected");
89
90$ipc->drop_hub($hid);
91ok(!-f $ipc->tempdir . '/' . $hid, "removed hub file");
92
93$ipc->send($hid, bless({global => 1}, 'Foo'), 'GLOBAL');
94my @got = $ipc->cull($hid);
95ok(@got == 0, "did not get our own global event");
96
97my $tmpdir = $ipc->tempdir;
98ok(-d $tmpdir, "still have temp dir");
99$ipc = undef;
100ok(!-d $tmpdir, "cleaned up temp dir");
101
102{
103    my $ipc = Test2::IPC::Driver::Files->new();
104
105    my $tmpdir = $ipc->tempdir;
106
107    my $ipc_thread_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
108    $ipc_thread_clone->set_tid(100);
109    $ipc_thread_clone = undef;
110    ok(-d $tmpdir, "Directory not removed (different thread)");
111
112    my $ipc_fork_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
113    $ipc_fork_clone->set_pid($$ + 10);
114    $ipc_fork_clone = undef;
115    ok(-d $tmpdir, "Directory not removed (different proc)");
116
117
118    $ipc_thread_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
119    $ipc_thread_clone->set_tid(undef);
120    $ipc_thread_clone = undef;
121    ok(-d $tmpdir, "Directory not removed (no thread)");
122
123    $ipc_fork_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
124    $ipc_fork_clone->set_pid(undef);
125    $ipc_fork_clone = undef;
126    ok(-d $tmpdir, "Directory not removed (no proc)");
127
128    $ipc = undef;
129    ok(!-d $tmpdir, "Directory removed");
130}
131
132{
133    no warnings qw/once redefine/;
134    local *Test2::IPC::Driver::Files::driver_abort = sub {};
135    local *Test2::IPC::Driver::Files::abort = sub {
136        my $self = shift;
137        local $self->{no_fatal} = 1;
138        local $self->{no_bail} = 1;
139        $self->Test2::IPC::Driver::abort(@_);
140        die 255;
141    };
142
143    my $tmpdir;
144    my @lines;
145    my $file = __FILE__;
146
147    my $out = simple_capture {
148        local $ENV{T2_KEEP_TEMPDIR} = 1;
149
150        my $ipc = Test2::IPC::Driver::Files->new();
151        $tmpdir = $ipc->tempdir;
152        $ipc->add_hub($hid);
153        eval { $ipc->add_hub($hid) }; push @lines => __LINE__;
154        $ipc->send($hid, bless({ foo => 1 }, 'Foo'));
155        $ipc->cull($hid);
156        $ipc->drop_hub($hid);
157        eval { $ipc->drop_hub($hid) }; push @lines => __LINE__;
158
159        # Make sure having a hub file sitting around does not throw things off
160        # in T2_KEEP_TEMPDIR
161        $ipc->add_hub($hid);
162        $ipc = undef;
163        1;
164    };
165
166    my $cleanup = sub {
167        if (opendir(my $d, $tmpdir)) {
168            for my $f (readdir($d)) {
169                next if $f =~ m/^\.+$/;
170                my $file = File::Spec->catfile($tmpdir, $f);
171                next unless -f $file;
172                1 while unlink $file;
173            }
174            closedir($d);
175            rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!";
176        }
177    };
178    $cleanup->();
179
180    like($out->{STDERR}, qr/IPC Temp Dir: \Q$tmpdir\E/m, "Got temp dir path");
181    like($out->{STDERR}, qr/^# Not removing temp dir: \Q$tmpdir\E$/m, "Notice about not closing tempdir");
182
183    like($out->{STDERR}, qr/^IPC Fatal Error: File for hub '$hid' already exists/m, "Got message for duplicate hub");
184    like($out->{STDERR}, qr/^IPC Fatal Error: File for hub '$hid' does not exist/m, "Cannot remove hub twice");
185
186    $out = simple_capture {
187        my $ipc = Test2::IPC::Driver::Files->new();
188        $ipc->add_hub($hid);
189        my $trace = Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'foo']);
190        my $e = eval { $ipc->send($hid, bless({glob => \*ok, trace => $trace}, 'Foo')); 1 };
191        print STDERR $@ unless $e || $@ =~ m/^255/;
192        $ipc->drop_hub($hid);
193    };
194
195    like($out->{STDERR}, qr/IPC Fatal Error:/, "Got fatal error");
196    like($out->{STDERR}, qr/There was an error writing an event/, "Explanation");
197    like($out->{STDERR}, qr/Destination: $hid/, "Got dest");
198    like($out->{STDERR}, qr/Origin PID:\s+$$/, "Got pid");
199    like($out->{STDERR}, qr/Error: Can't store GLOB items/, "Got cause");
200
201    $out = simple_capture {
202        my $ipc = Test2::IPC::Driver::Files->new();
203        local $@;
204        eval { $ipc->send($hid, bless({ foo => 1 }, 'Foo')) };
205        print STDERR $@ unless $@ =~ m/^255/;
206        $ipc = undef;
207    };
208    like($out->{STDERR}, qr/IPC Fatal Error: hub '$hid' is not available, failed to send event!/, "Cannot send to missing hub");
209
210    $out = simple_capture {
211        my $ipc = Test2::IPC::Driver::Files->new();
212        $tmpdir = $ipc->tempdir;
213        $ipc->add_hub($hid);
214        $ipc->send($hid, bless({ foo => 1 }, 'Foo'));
215        local $@;
216        eval { $ipc->drop_hub($hid) };
217        print STDERR $@ unless $@ =~ m/^255/;
218    };
219    $cleanup->();
220    like($out->{STDERR}, qr/IPC Fatal Error: Not all files from hub '$hid' have been collected/, "Leftover files");
221    like($out->{STDERR}, qr/IPC Fatal Error: Leftover files in the directory \(.*\.ready\)/, "What file");
222
223    $out = simple_capture {
224        my $ipc = Test2::IPC::Driver::Files->new();
225        $ipc->add_hub($hid);
226
227        eval { $ipc->send($hid, { foo => 1 }) };
228        print STDERR $@ unless $@ =~ m/^255/;
229
230        eval { $ipc->send($hid, bless({ foo => 1 }, 'xxx')) };
231        print STDERR $@ unless $@ =~ m/^255/;
232    };
233    like($out->{STDERR}, qr/IPC Fatal Error: 'HASH\(.*\)' is not a blessed object/, "Cannot send unblessed objects");
234    like($out->{STDERR}, qr/IPC Fatal Error: 'xxx=HASH\(.*\)' is not an event object!/, "Cannot send non-event objects");
235
236
237    $ipc = Test2::IPC::Driver::Files->new();
238
239    my ($fh, $fn) = tempfile();
240    print $fh "\n";
241    close($fh);
242
243    Storable::store({}, $fn);
244    $out = simple_capture { eval { $ipc->read_event_file($fn) } };
245    like(
246        $out->{STDERR},
247        qr/IPC Fatal Error: Got an unblessed object: 'HASH\(.*\)'/,
248        "Events must actually be events (must be blessed)"
249    );
250
251    Storable::store(bless({}, 'Test2::Event::FakeEvent'), $fn);
252    $out = simple_capture { eval { $ipc->read_event_file($fn) } };
253    like(
254        $out->{STDERR},
255        qr{IPC Fatal Error: Event has unknown type \(Test2::Event::FakeEvent\), tried to load 'Test2/Event/FakeEvent\.pm' but failed: Can't locate Test2/Event/FakeEvent\.pm},
256        "Events must actually be events (not a real module)"
257    );
258
259    Storable::store(bless({}, 'Test2::API'), $fn);
260    $out = simple_capture { eval { $ipc->read_event_file($fn) } };
261    like(
262        $out->{STDERR},
263        qr{'Test2::API=HASH\(.*\)' is not a 'Test2::Event' object},
264        "Events must actually be events (not an event type)"
265    );
266
267    Storable::store(bless({}, 'Foo'), $fn);
268    $out = simple_capture {
269        local @INC;
270        push @INC => ('t/lib', 'lib');
271        eval { $ipc->read_event_file($fn) };
272    };
273    ok(!$out->{STDERR}, "no problem", $out->{STDERR});
274    ok(!$out->{STDOUT}, "no problem", $out->{STDOUT});
275
276    unlink($fn);
277}
278
279{
280    my $ipc = Test2::IPC::Driver::Files->new();
281    $ipc->add_hub($hid);
282    $ipc->send($hid, bless({global => 1}, 'Foo'), 'GLOBAL');
283    $ipc->set_globals({});
284    my @events = $ipc->cull($hid);
285    is_deeply(
286        \@events,
287        [ {global => 1} ],
288        "Got global event"
289    );
290
291    @events = $ipc->cull($hid);
292    ok(!@events, "Did not grab it again");
293
294    $ipc->set_globals({});
295    @events = $ipc->cull($hid);
296    is_deeply(
297        \@events,
298        [ {global => 1} ],
299        "Still there"
300    );
301
302    $ipc->drop_hub($hid);
303    $ipc = undef;
304}
305
306{
307    my @list = shuffle (
308        {global => 0, pid => 2, tid => 1, eid => 1},
309        {global => 0, pid => 2, tid => 1, eid => 2},
310        {global => 0, pid => 2, tid => 1, eid => 3},
311
312        {global => 1, pid => 1,  tid => 1, eid => 1},
313        {global => 1, pid => 12, tid => 1, eid => 3},
314        {global => 1, pid => 11, tid => 1, eid => 2},
315
316        {global => 0, pid => 2, tid => 3, eid => 1},
317        {global => 0, pid => 2, tid => 3, eid => 10},
318        {global => 0, pid => 2, tid => 3, eid => 100},
319
320        {global => 0, pid => 5, tid => 3, eid => 2},
321        {global => 0, pid => 5, tid => 3, eid => 20},
322        {global => 0, pid => 5, tid => 3, eid => 200},
323    );
324
325    my @sorted;
326    {
327        package Test2::IPC::Driver::Files;
328        @sorted = sort cmp_events @list;
329    }
330
331    is_deeply(
332        \@sorted,
333        [
334            {global => 1, pid => 1,  tid => 1, eid => 1},
335            {global => 1, pid => 11, tid => 1, eid => 2},
336            {global => 1, pid => 12, tid => 1, eid => 3},
337
338            {global => 0, pid => 2, tid => 1, eid => 1},
339            {global => 0, pid => 2, tid => 1, eid => 2},
340            {global => 0, pid => 2, tid => 1, eid => 3},
341
342            {global => 0, pid => 2, tid => 3, eid => 1},
343            {global => 0, pid => 2, tid => 3, eid => 10},
344            {global => 0, pid => 2, tid => 3, eid => 100},
345
346            {global => 0, pid => 5, tid => 3, eid => 2},
347            {global => 0, pid => 5, tid => 3, eid => 20},
348            {global => 0, pid => 5, tid => 3, eid => 200},
349        ],
350        "Sort by global, pid, tid and then eid"
351    );
352}
353
354{
355    my $ipc = 'Test2::IPC::Driver::Files';
356
357    is_deeply(
358        $ipc->parse_event_filename(join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo.ready.complete'),
359        {
360            ready    => !!1,
361            complete => !!1,
362            global   => 1,
363            type     => "Event::Type::Foo",
364            hid      => "GLOBAL",
365            pid      => "123",
366            tid      => "456",
367            eid      => "789",
368            file     => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
369        },
370        "Parsed global complete"
371    );
372
373    is_deeply(
374        $ipc->parse_event_filename(join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo.ready'),
375        {
376            ready    => !!1,
377            complete => !!0,
378            global   => 1,
379            type     => "Event::Type::Foo",
380            hid      => "GLOBAL",
381            pid      => "123",
382            tid      => "456",
383            eid      => "789",
384            file     => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
385        },
386        "Parsed global ready"
387    );
388
389    is_deeply(
390        $ipc->parse_event_filename(join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo'),
391        {
392            ready    => !!0,
393            complete => !!0,
394            global   => 1,
395            type     => "Event::Type::Foo",
396            hid      => "GLOBAL",
397            pid      => "123",
398            tid      => "456",
399            eid      => "789",
400            file     => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
401        },
402        "Parsed global not ready"
403    );
404
405    is_deeply(
406        $ipc->parse_event_filename(join ipc_separator, qw'1 1 1 1 123 456 789 Event Type Foo.ready.complete'),
407        {
408            ready    => !!1,
409            complete => !!1,
410            global   => 0,
411            type     => "Event::Type::Foo",
412            hid      => "1${sep}1${sep}1${sep}1",
413            pid      => "123",
414            tid      => "456",
415            eid      => "789",
416            file     => join ipc_separator, qw'1 1 1 1 123 456 789 Event Type Foo',
417        },
418        "Parsed event complete"
419    );
420
421    is_deeply(
422        $ipc->parse_event_filename(join ipc_separator, qw'1 2 3 4 123 456 789 Event Type Foo.ready'),
423        {
424            ready    => !!1,
425            complete => !!0,
426            global   => 0,
427            type     => "Event::Type::Foo",
428            hid      => "1${sep}2${sep}3${sep}4",
429            pid      => "123",
430            tid      => "456",
431            eid      => "789",
432            file     => join ipc_separator, qw'1 2 3 4 123 456 789 Event Type Foo',
433        },
434        "Parsed event ready"
435    );
436
437    is_deeply(
438        $ipc->parse_event_filename(join ipc_separator, qw'3 2 11 12 123 456 789 Event'),
439        {
440            ready    => !!0,
441            complete => !!0,
442            global   => 0,
443            type     => "Event",
444            hid      => "3${sep}2${sep}11${sep}12",
445            pid      => "123",
446            tid      => "456",
447            eid      => "789",
448            file     => join ipc_separator, qw'3 2 11 12 123 456 789 Event',
449        },
450        "Parsed event not ready"
451    );
452}
453
454{
455    my $ipc = Test2::IPC::Driver::Files->new();
456
457    my $hid = join ipc_separator, qw"1 1 1 1";
458
459    is_deeply(
460        $ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo.ready.complete") ? 1 : 0,
461        0,
462        "Do not read complete global"
463    );
464
465    is_deeply(
466        $ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo.ready") ? 1 : 0,
467        1,
468        "Should read ready global the first time"
469    );
470    is_deeply(
471        $ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo.ready") ? 1 : 0,
472        0,
473        "Should not read ready global again"
474    );
475
476    is_deeply(
477        $ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo") ? 1 : 0,
478        0,
479        "Should not read un-ready global"
480    );
481
482    is_deeply(
483        $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready.complete") ? 1 : 0,
484        0,
485        "Do not read complete our hid"
486    );
487
488    is_deeply(
489        $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready") ? 1 : 0,
490        1,
491        "Should read ready our hid"
492    );
493
494    is_deeply(
495        $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready") ? 1 : 0,
496        1,
497        "Should read ready our hid (again, no duplicate checking)"
498    );
499
500    is_deeply(
501        $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo") ? 1 : 0,
502        0,
503        "Should not read un-ready our hid"
504    );
505
506    is_deeply(
507        $ipc->should_read_event($hid, join ipc_separator, qw"1 2 3 123 456 789 Event Type Foo.ready.complete") ? 1 : 0,
508        0,
509        "Not ours - complete"
510    );
511
512    is_deeply(
513        $ipc->should_read_event($hid, join ipc_separator, qw"1 2 3 123 456 789 Event Type Foo.ready") ? 1 : 0,
514        0,
515        "Not ours - ready"
516    );
517
518    is_deeply(
519        $ipc->should_read_event($hid, join ipc_separator, qw"1 2 3 123 456 789 Event Type Foo") ? 1 : 0,
520        0,
521        "Not ours - unready"
522    );
523
524    my @got = $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo");
525    ok(!@got, "return empty list for false");
526
527    @got = $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready");
528    is(@got, 1, "got 1 item on true");
529
530    like(delete $got[0]->{full_path}, qr{^.+\Q$hid\E${sep}123${sep}456${sep}789${sep}Event${sep}Type${sep}Foo\.ready$}, "Got full path");
531    is_deeply(
532        $got[0],
533        $ipc->parse_event_filename(join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready"),
534        "Apart from full_path we get entire parsed filename"
535    );
536
537    $ipc = undef;
538}
539
540done_testing;
541