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