1use strict; 2use warnings; 3 4BEGIN { 5 use Config; 6 if (! $Config{'useithreads'}) { 7 print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); 8 exit(0); 9 } 10} 11 12use ExtUtils::testlib; 13 14sub ok { 15 my ($id, $ok, $name) = @_; 16 17 # You have to do it this way or VMS will get confused. 18 if ($ok) { 19 print("ok $id - $name\n"); 20 } else { 21 print("not ok $id - $name\n"); 22 printf("# Failed test at line %d\n", (caller)[2]); 23 } 24 25 return ($ok); 26} 27 28sub is { 29 my ($id, $got, $expected, $name) = @_; 30 31 my $ok = ok($id, $got == $expected, $name); 32 if (! $ok) { 33 print(" GOT: $got\n"); 34 print("EXPECTED: $expected\n"); 35 } 36 37 return ($ok); 38} 39 40my $frame_size; 41my $frames; 42my $size; 43 44BEGIN { 45 $| = 1; 46 print("1..4\n"); ### Number of tests that will be run ### 47 48 # XXX Note that if the default stack size happens to be the same as these 49 # numbers, that test 2 would return success just out of happenstance. 50 # This possibility could be lessened by choosing $frames to be something 51 # less likely than a power of 2 52 53 $frame_size = 4096; 54 $frames = 128; 55 $size = $frames * $frame_size; 56 57 $ENV{'PERL5_ITHREADS_STACK_SIZE'} = $size; 58}; 59 60use threads; 61ok(1, 1, 'Loaded'); 62 63### Start of Testing ### 64 65my $actual_size = threads->get_stack_size(); 66 67{ 68 if ($actual_size > $size) { 69 print("ok 2 # skip because system needs larger minimum stack size\n"); 70 $size = $actual_size; 71 } 72 else { 73 is(2, $actual_size, $size, '$ENV{PERL5_ITHREADS_STACK_SIZE}'); 74 } 75} 76 77my $size_plus_eighth = $size * 1.125; # 128 frames map to 144 78is(3, threads->set_stack_size($size_plus_eighth), $size, 79 'Set returns previous value'); 80is(4, threads->get_stack_size(), $size_plus_eighth, 81 'Get stack size'); 82 83exit(0); 84 85# EOF 86