view release on metacpan or  search on metacpan

tests/602_threads.t  view on Meta::CPAN

################################################################################
#
# Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################

use Test;
use Config;
use Convert::Binary::C @ARGV;
use constant NUM_THREADS => 4;

$^W = 1;

BEGIN {
  plan tests => NUM_THREADS
}

my $CCCFG = require './tests/include/config.pl';

#===================================================================
# load appropriate threads module and start a couple of threads
#===================================================================

my $have_threads = ($Config{useithreads} && $] >= 5.008) ||
                    $Config{use5005threads};

my $reason = $Config{useithreads} || $Config{use5005threads}
             ? "unsupported threads configuration"
             : "no threads";

if ($have_threads && $] > 5.009004 && $] < 5.010001) {
  # Threads are broken between 5.9.4 and 5.10.1
  $reason = "threads are broken in this perl version";
  $have_threads = 0;
}

my @t;

if ($have_threads) {
  if ($Config{use5005threads}) {
    require Thread;
    @t = map { Thread->new( \&task, $_ ) } 1 .. NUM_THREADS;
  }
  elsif ($Config{useithreads} && $] >= 5.008) {
    require threads;
    @t = map { threads->new( \&task, $_ ) } 1 .. NUM_THREADS;
  }
}
else {
  Convert::Binary::C->new->parse('');  # allocate/free some memory
  @t = 1 .. NUM_THREADS
}

skip($have_threads ? '' : $reason,
     $have_threads ? $_->join : $_, '', "thread failed") for @t;

sub task
{
  my $arg = shift;
  my $p;

  eval {
    $p = Convert::Binary::C->new(
      %$CCCFG,
      EnumSize       => 0,
    );
    if ($arg % 2) {
      print "# parse_file ($arg) called\n";
      $p->parse_file('tests/include/include.c');
      print "# parse_file ($arg) returned\n";
    }
    else {
      open FH, "tests/include/include.c" or die;
      my $code = do { local $/; <FH> };
      close FH;
      print "# parse ($arg) called\n";
      $p->parse($code);
      print "# parse ($arg) returned\n";