perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/response/TestPerl ithreads.pm
Date Fri, 25 Jul 2003 08:16:59 GMT
stas        2003/07/25 01:16:59

  Added:       t/perl   ithreads2.t ithreads.t
               t/response/TestPerl ithreads.pm
  Log:
  - move the ithreads stuff into a new tree: perl/
  - now testing the same functionality from the global perl interpreter pool
    and from the +Parent pool
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/perl/ithreads2.t
  
  Index: ithreads2.t
  ===================================================================
  # perl/ithreads is a similar test but is running from the global perl
  # interpreter pool. whereas this test is running against a
  # virtual host with its own perl interpreter pool (+Parent)
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest 'GET_BODY_ASSERT';
  
  my $module = 'TestPerl::ithreads';
  my $config = Apache::Test::config();
  my $path = Apache::TestRequest::module2path($module);
  
  Apache::TestRequest::module($module);
  my $hostport = Apache::TestRequest::hostport($config);
  
  t_debug("connecting to $hostport");
  print GET_BODY_ASSERT "http://$hostport/$path";
  
  
  
  1.1                  modperl-2.0/t/perl/ithreads.t
  
  Index: ithreads.t
  ===================================================================
  # perl/ithreads2 is a similar test but is running from within a
  # virtual host with its own perl interpreter pool (+Parent)
  
  use Apache::TestRequest 'GET_BODY_ASSERT';
  print GET_BODY_ASSERT "/TestPerl__ithreads";
  
  
  
  1.1                  modperl-2.0/t/response/TestPerl/ithreads.pm
  
  Index: ithreads.pm
  ===================================================================
  package TestPerl::ithreads;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestTrace;
  
  use Apache::Const -compile => 'OK';
  
  # XXX: at this moment ithreads can be used only with 5.8.1. However
  # once ithreads will be available on CPAN, we will need to change the
  # check for perl 5.8.0 and this certain version of ithreads (here and
  # in t/conf/modperl_extra.pl
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 4, have
          have_threads,
          {"perl >= 5.8.1 is required (this is $])" => ($] >= 5.008001)};
  
      # threads must have been preloaded at the server startup for this
      # test (this is done at t/conf/modperl_extra.pl)
      require threads;
      threads->import();
  
      # sky: the more modules are loaded, the slower new ithreads start
      #      because more things need to be cloned
      debug '%INC size: ' . scalar(keys %INC) . "\n";
  
      {
          my $tid = threads->self->tid;
          debug "1st TID is $tid" if defined $tid;
          ok defined $tid;
      }
  
      {
          my $thr = threads->new(sub { 
                                     my $tid = threads->self->tid; 
                                     debug "2nd TID is $tid" if defined $tid;
                                     return 2;
                                 });
          ok t_cmp(2, $thr->join, "thread callback returned value");
      }
  
      {
          require threads::shared;
          my $counter_priv          = 1;
          my $counter_shar : shared = 1;
          my $thr = threads->new(sub : locked { 
                                     my $tid = threads->self->tid; 
                                     debug "2nd TID is $tid" if defined $tid;
                                     $counter_priv += $counter_priv for 1..10;
                                     $counter_shar += $counter_shar for 1..10;
                                     return 2;
                                 });
          $counter_priv += $counter_priv for 1..10;
          $counter_shar += $counter_shar for 1..10;
          my $ret = $thr->join;
          ok t_cmp(2**20, $counter_shar, "shared counter");
          ok t_cmp(2**10, $counter_priv, "private counter");
      }
  
      Apache::OK;
  }
  
  1;
  
  __END__
  # APACHE_TEST_CONFIG_ORDER 941
  
  <VirtualHost TestPerl::ithreads>
  
      <IfDefine PERL_USEITHREADS>
          # a new interpreter pool
          PerlOptions +Parent
      </IfDefine>
  
      # use test system's @INC
      PerlSwitches -I@serverroot@
      PerlRequire "conf/modperl_inc.pl"
      PerlModule Apache2
  
      <Location /TestPerl__ithreads>
          SetHandler modperl
          PerlResponseHandler TestPerl::ithreads
      </Location>
  
  </VirtualHost>
  
  
  

Mime
View raw message