ext/threads/t/stress_string.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13
  14 my $test = 0;
  15 sub ok {
  16     my ($ok, $name) = @_;
  17     $test++;
  18
  19     # You have to do it this way or VMS will get confused.
  20     if ($ok) {
  21         print("ok $test - $name\n");
  22     } else {
  23         print("not ok $test - $name\n");
  24         printf("# Failed test at line %d\n", (caller)[2]);
  25     }
  26
  27     return ($ok);
  28 }
  29
  30 BEGIN {
  31     $| = 1;
  32     print("1..61\n");   ### Number of tests that will be run ###
  33 };
  34
  35 use threads;
  36 ok(1, 'Loaded');
  37
  38 ### Start of Testing ###
  39
  40 my $cnt = 30;
  41
  42 sub test9 {
  43     my $i = shift;
  44     for (1..500000) { $i++ };
  45 }
  46
  47 my @threads;
  48 for (1..$cnt) {
  49     my $thr = threads->create('test9', $_);
  50     ok($thr, "Thread created - iter $_");
  51     push(@threads, $thr);
  52 }
  53
  54 for (1..$cnt) {
  55     my ($result, $thr);
  56     $thr = $threads[$_-1];
  57     $result = $thr->join if $thr;
  58     ok($thr, "Thread joined - iter $_");
  59 }
  60
  61 exit(0);
  62
  63 # EOF