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 12my $frame_size; 13my $frames; 14my $size; 15 16BEGIN { 17 # XXX Note that if the default stack size happens to be the same as these 18 # numbers, that test 2 would return success just out of happenstance. 19 # This possibility could be lessened by choosing $frames to be something 20 # less likely than a power of 2 21 $frame_size = 4096; 22 $frames = 128; 23 $size = $frames * $frame_size; 24} 25 26use ExtUtils::testlib; 27 28sub ok { 29 my ($id, $ok, $name) = @_; 30 31 # You have to do it this way or VMS will get confused. 32 if ($ok) { 33 print("ok $id - $name\n"); 34 } else { 35 print("not ok $id - $name\n"); 36 printf("# Failed test at line %d\n", (caller)[2]); 37 } 38 39 return ($ok); 40} 41 42sub is { 43 my ($id, $got, $expected, $name) = @_; 44 45 my $ok = ok($id, $got == $expected, $name); 46 if (! $ok) { 47 print(" GOT: $got\n"); 48 print("EXPECTED: $expected\n"); 49 } 50 51 return ($ok); 52} 53 54BEGIN { 55 $| = 1; 56 print("1..18\n"); ### Number of tests that will be run ### 57}; 58 59use threads ('stack_size' => $size); 60ok(1, 1, 'Loaded'); 61 62### Start of Testing ### 63 64my $actual_size = threads->get_stack_size(); 65 66{ 67 if ($actual_size > $size) { 68 print("ok 2 # skip because system needs larger minimum stack size\n"); 69 $size = $actual_size; 70 } 71 else { 72 is(2, $actual_size, $size, 'Stack size set in import'); 73 } 74} 75 76my $size_plus_quarter = $size * 1.25; # 128 frames map to 160 77is(3, threads->set_stack_size($size_plus_quarter), $size, 78 'Set returns previous value'); 79is(4, threads->get_stack_size(), $size_plus_quarter, 80 'Get stack size'); 81 82threads->create( 83 sub { 84 is(5, threads->get_stack_size(), $size_plus_quarter, 85 'Get stack size in thread'); 86 is(6, threads->self()->get_stack_size(), $size_plus_quarter, 87 'Thread gets own stack size'); 88 is(7, threads->set_stack_size($size), $size_plus_quarter, 89 'Thread changes stack size'); 90 is(8, threads->get_stack_size(), $size, 91 'Get stack size in thread'); 92 is(9, threads->self()->get_stack_size(), $size_plus_quarter, 93 'Thread stack size unchanged'); 94 } 95)->join(); 96 97is(10, threads->get_stack_size(), $size, 98 'Default thread sized changed in thread'); 99 100threads->create( 101 { 'stack' => $size_plus_quarter }, 102 sub { 103 is(11, threads->get_stack_size(), $size, 104 'Get stack size in thread'); 105 is(12, threads->self()->get_stack_size(), $size_plus_quarter, 106 'Thread gets own stack size'); 107 } 108)->join(); 109 110my $thr = threads->create( { 'stack' => $size_plus_quarter }, sub { } ); 111 112$thr->create( 113 sub { 114 is(13, threads->get_stack_size(), $size, 115 'Get stack size in thread'); 116 is(14, threads->self()->get_stack_size(), $size_plus_quarter, 117 'Thread gets own stack size'); 118 } 119)->join(); 120 121my $size_plus_eighth = $size * 1.125; # 128 frames map to 144 122$thr->create( 123 { 'stack' => $size_plus_eighth }, 124 sub { 125 is(15, threads->get_stack_size(), $size, 126 'Get stack size in thread'); 127 is(16, threads->self()->get_stack_size(), $size_plus_eighth, 128 'Thread gets own stack size'); 129 is(17, threads->set_stack_size($size_plus_quarter), $size, 130 'Thread changes stack size'); 131 } 132)->join(); 133 134$thr->join(); 135 136is(18, threads->get_stack_size(), $size_plus_quarter, 137 'Default thread sized changed in thread'); 138 139exit(0); 140 141# EOF 142