1use strict; 2use warnings; 3 4use Test2::API qw/context/; 5 6my ($LOADED, $INIT); 7BEGIN { 8 $INIT = Test2::API::test2_init_done; 9 $LOADED = Test2::API::test2_load_done; 10}; 11 12use Test2::IPC; 13use Test2::Tools::Tiny; 14use Test2::Util qw/get_tid/; 15my $CLASS = 'Test2::API'; 16 17# Ensure we do not break backcompat later by removing anything 18ok(Test2::API->can($_), "$_ method is present") for qw{ 19 context_do 20 no_context 21 22 test2_init_done 23 test2_load_done 24 25 test2_pid 26 test2_tid 27 test2_stack 28 test2_no_wait 29 30 test2_add_callback_context_init 31 test2_add_callback_context_release 32 test2_add_callback_exit 33 test2_add_callback_post_load 34 test2_list_context_init_callbacks 35 test2_list_context_release_callbacks 36 test2_list_exit_callbacks 37 test2_list_post_load_callbacks 38 39 test2_ipc 40 test2_ipc_disable 41 test2_ipc_disabled 42 test2_ipc_drivers 43 test2_ipc_add_driver 44 test2_ipc_polling 45 test2_ipc_disable_polling 46 test2_ipc_enable_polling 47 48 test2_formatter 49 test2_formatters 50 test2_formatter_add 51 test2_formatter_set 52}; 53 54ok(!$LOADED, "Was not load_done right away"); 55ok(!$INIT, "Init was not done right away"); 56ok(Test2::API::test2_load_done, "We loaded it"); 57 58# Note: This is a check that stuff happens in an END block. 59{ 60 { 61 package FOLLOW; 62 63 sub DESTROY { 64 return if $_[0]->{fixed}; 65 print "not ok - Did not run end ($_[0]->{name})!"; 66 $? = 255; 67 exit 255; 68 } 69 } 70 71 our $kill1 = bless {fixed => 0, name => "Custom Hook"}, 'FOLLOW'; 72 Test2::API::test2_add_callback_exit( 73 sub { 74 print "# Running END hook\n"; 75 $kill1->{fixed} = 1; 76 } 77 ); 78 79 our $kill2 = bless {fixed => 0, name => "set exit"}, 'FOLLOW'; 80 my $old = Test2::API::Instance->can('set_exit'); 81 no warnings 'redefine'; 82 *Test2::API::Instance::set_exit = sub { 83 $kill2->{fixed} = 1; 84 print "# Running set_exit\n"; 85 $old->(@_); 86 }; 87} 88 89ok($CLASS->can('test2_init_done')->(), "init is done."); 90ok($CLASS->can('test2_load_done')->(), "Test2 is finished loading"); 91 92is($CLASS->can('test2_pid')->(), $$, "got pid"); 93is($CLASS->can('test2_tid')->(), get_tid(), "got tid"); 94 95ok($CLASS->can('test2_stack')->(), 'got stack'); 96is($CLASS->can('test2_stack')->(), $CLASS->can('test2_stack')->(), "always get the same stack"); 97 98ok($CLASS->can('test2_ipc')->(), 'got ipc'); 99is($CLASS->can('test2_ipc')->(), $CLASS->can('test2_ipc')->(), "always get the same IPC"); 100 101is_deeply([$CLASS->can('test2_ipc_drivers')->()], [qw/Test2::IPC::Driver::Files/], "Got driver list"); 102 103# Verify it reports to the correct file/line, there was some trouble with this... 104my $file = __FILE__; 105my $line = __LINE__ + 1; 106my $warnings = warnings { $CLASS->can('test2_ipc_add_driver')->('fake') }; 107my $sub1 = sub { 108like( 109 $warnings->[0], 110 qr{^IPC driver fake loaded too late to be used as the global ipc driver at \Q$file\E line $line}, 111 "got warning about adding driver too late" 112); 113}; 114if ($] le "5.006002") { 115 todo("TODO known to fail on $]", $sub1); 116} else { 117 $sub1->(); 118} 119 120is_deeply([$CLASS->can('test2_ipc_drivers')->()], [qw/fake Test2::IPC::Driver::Files/], "Got updated list"); 121 122ok($CLASS->can('test2_ipc_polling')->(), "Polling is on"); 123$CLASS->can('test2_ipc_disable_polling')->(); 124ok(!$CLASS->can('test2_ipc_polling')->(), "Polling is off"); 125$CLASS->can('test2_ipc_enable_polling')->(); 126ok($CLASS->can('test2_ipc_polling')->(), "Polling is on"); 127 128ok($CLASS->can('test2_formatter')->(), "Got a formatter"); 129is($CLASS->can('test2_formatter')->(), $CLASS->can('test2_formatter')->(), "always get the same Formatter (class name)"); 130 131my $ran = 0; 132$CLASS->can('test2_add_callback_post_load')->(sub { $ran++ }); 133is($ran, 1, "ran the post-load"); 134 135like( 136 exception { $CLASS->can('test2_formatter_set')->() }, 137 qr/No formatter specified/, 138 "formatter_set requires an argument" 139); 140 141like( 142 exception { $CLASS->can('test2_formatter_set')->('fake') }, 143 qr/Global Formatter already set/, 144 "formatter_set doesn't work after initialization", 145); 146 147ok(!$CLASS->can('test2_no_wait')->(), "no_wait is not set"); 148$CLASS->can('test2_no_wait')->(1); 149ok($CLASS->can('test2_no_wait')->(), "no_wait is set"); 150$CLASS->can('test2_no_wait')->(undef); 151ok(!$CLASS->can('test2_no_wait')->(), "no_wait is not set"); 152 153ok($CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting enabled"); 154$CLASS->can('test2_ipc_wait_disable')->(); 155ok(!$CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting disabled"); 156$CLASS->can('test2_ipc_wait_enable')->(); 157ok($CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting enabled"); 158 159my $pctx; 160sub tool_a($;$) { 161 Test2::API::context_do { 162 my $ctx = shift; 163 my ($bool, $name) = @_; 164 $pctx = wantarray; 165 die "xyz" unless $bool; 166 $ctx->ok($bool, $name); 167 return unless defined $pctx; 168 return (1, 2) if $pctx; 169 return 'a'; 170 } @_; 171} 172 173$pctx = 'x'; 174tool_a(1, "void context test"); 175ok(!defined($pctx), "void context"); 176 177my $x = tool_a(1, "scalar context test"); 178ok(defined($pctx) && $pctx == 0, "scalar context"); 179is($x, 'a', "got scalar return"); 180 181my @x = tool_a(1, "array context test"); 182ok($pctx, "array context"); 183is_deeply(\@x, [1, 2], "Got array return"); 184 185like( 186 exception { tool_a(0) }, 187 qr/^xyz/, 188 "got exception" 189); 190 191sub { 192 my $outer = context(); 193 sub { 194 my $middle = context(); 195 is($outer->trace, $middle->trace, "got the same context before calling no_context"); 196 197 Test2::API::no_context { 198 my $inner = context(); 199 ok($inner->trace != $outer->trace, "Got a different context inside of no_context()"); 200 $inner->release; 201 }; 202 203 $middle->release; 204 }->(); 205 206 $outer->release; 207}->(); 208 209sub { 210 my $outer = context(); 211 sub { 212 my $middle = context(); 213 is($outer->trace, $middle->trace, "got the same context before calling no_context"); 214 215 Test2::API::no_context { 216 my $inner = context(); 217 ok($inner->trace != $outer->trace, "Got a different context inside of no_context({}, hid)"); 218 $inner->release; 219 } $outer->hub->hid; 220 221 $middle->release; 222 }->(); 223 224 $outer->release; 225}->(); 226 227sub { 228 my @warnings; 229 my $outer = context(); 230 sub { 231 my $middle = context(); 232 is($outer->trace, $middle->trace, "got the same context before calling no_context"); 233 234 local $SIG{__WARN__} = sub { push @warnings => @_ }; 235 Test2::API::no_context { 236 my $inner = context(); 237 ok($inner->trace != $outer->trace, "Got a different context inside of no_context({}, hid)"); 238 } $outer->hub->hid; 239 240 $middle->release; 241 }->(); 242 243 $outer->release; 244 245 is(@warnings, 1, "1 warning"); 246 like( 247 $warnings[0], 248 qr/A context appears to have been destroyed without first calling release/, 249 "Got warning about unreleased context" 250 ); 251}->(); 252 253 254sub { 255 my $hub = Test2::Hub->new(); 256 my $ctx = context(hub => $hub); 257 is($ctx->hub,$hub, 'got the hub of context() argument'); 258 $ctx->release; 259}->(); 260 261 262my $sub = sub { }; 263 264Test2::API::test2_add_callback_context_acquire($sub); 265Test2::API::test2_add_callback_context_init($sub); 266Test2::API::test2_add_callback_context_release($sub); 267Test2::API::test2_add_callback_exit($sub); 268Test2::API::test2_add_callback_post_load($sub); 269 270is((grep { $_ == $sub } Test2::API::test2_list_context_acquire_callbacks()), 1, "got the one instance of the hook"); 271is((grep { $_ == $sub } Test2::API::test2_list_context_init_callbacks()), 1, "got the one instance of the hook"); 272is((grep { $_ == $sub } Test2::API::test2_list_context_release_callbacks()), 1, "got the one instance of the hook"); 273is((grep { $_ == $sub } Test2::API::test2_list_exit_callbacks()), 1, "got the one instance of the hook"); 274is((grep { $_ == $sub } Test2::API::test2_list_post_load_callbacks()), 1, "got the one instance of the hook"); 275 276Test2::API::test2_add_callback_context_acquire($sub); 277Test2::API::test2_add_callback_context_init($sub); 278Test2::API::test2_add_callback_context_release($sub); 279Test2::API::test2_add_callback_exit($sub); 280Test2::API::test2_add_callback_post_load($sub); 281 282is((grep { $_ == $sub } Test2::API::test2_list_context_acquire_callbacks()), 2, "got the two instances of the hook"); 283is((grep { $_ == $sub } Test2::API::test2_list_context_init_callbacks()), 2, "got the two instances of the hook"); 284is((grep { $_ == $sub } Test2::API::test2_list_context_release_callbacks()), 2, "got the two instances of the hook"); 285is((grep { $_ == $sub } Test2::API::test2_list_exit_callbacks()), 2, "got the two instances of the hook"); 286is((grep { $_ == $sub } Test2::API::test2_list_post_load_callbacks()), 2, "got the two instances of the hook"); 287 288done_testing; 289 290